mirror of
https://github.com/marketideas/qasm.git
synced 2026-10-25 13:02:45 +00:00
Shawn Quick
dfcaae62dd
Move the assembler to src/qasm. qlink links OMF 1.0 and 2.0 from a script. makeBin flattens a load file, qomf dumps OMF, and qpro builds ProDOS volumes. APW and MPW assemble through the ORCA front end. Relocatable modules emit OMF objects. Listings stay off unless -l is set. make boot assembles the GS/OS 6.0.1 ProDOS 8 kernel and BASIC.SYSTEM into an 800K volume. BASIC.SYSTEM accepts ls and pfx, and its splash reports PRODOS BASIC 2.0, copyright 1983-2026. IIGS.601.SRC is the source and the BASIC.SYSTEM oracle that image is built from.
1 line
62 KiB
NASM
1 line
62 KiB
NASM
*******************************************************************************
|
|
*
|
|
* Copyright 1990-1993 Apple Computer, Inc
|
|
* All Rights Reserved
|
|
*
|
|
* 26-Jan-93 SS -- Removed QDAuxStartup call
|
|
*
|
|
*******************************************************************************
|
|
|
|
string asis
|
|
blanks off
|
|
|
|
print push,off
|
|
|
|
include 'All.macros'
|
|
include 'E16.Menu'
|
|
include 'E16.Event'
|
|
include 'E16.Locator'
|
|
|
|
Import CurrentDirPath
|
|
Import MyOpenRec
|
|
Import MyDirEntry
|
|
Import TempNamePtr
|
|
Import tempString
|
|
Import MyClose
|
|
Import MyID
|
|
Import MyListCnt
|
|
Import MyList
|
|
Import ListCtrl
|
|
Import AsmtoolErr
|
|
Import MatchType
|
|
Import MatchStr
|
|
Import IdleWind
|
|
Import VolPopUp
|
|
Import StackHandle
|
|
Import StackLevel
|
|
Import PascalStack
|
|
Import EntryCount
|
|
Import Stopping
|
|
Import SetMessage
|
|
Import ListCtrl
|
|
Import screenMode
|
|
entry MyMemberDraw
|
|
entry InsertIntoList
|
|
entry InsertTheItem
|
|
entry GetHandle
|
|
entry SetPopup
|
|
|
|
Entry AsmAddFile
|
|
GBLA &Debug
|
|
&Debug Seta 0
|
|
print pop
|
|
|
|
EJECT
|
|
*******************************************************************************
|
|
*
|
|
SetAboutMessage PROC Export
|
|
*
|
|
* Description: This little routine will set the about message in the message
|
|
* box and cause it to be drawn.
|
|
*
|
|
*
|
|
* Inputs: None
|
|
*
|
|
* Outputs: None
|
|
*
|
|
* External Refs:
|
|
*
|
|
* Entry Points:
|
|
*
|
|
*******************************************************************************
|
|
PushLong #VersionInfo
|
|
jsl SetMessage
|
|
rtl
|
|
|
|
VersionInfo dc.B textEnd-textStart
|
|
textStart
|
|
dc.B $01,$4A,$01,$00 ; center justify
|
|
dc.B 'Find File',$0d
|
|
dc.B '©1990-93 Apple Computer Inc.',$0d
|
|
dc.B 'by Mensch, Yee, Lyons, & Stephenson',$0D
|
|
dc.B 'Tested by M.S. & B.K. & J.J.J'
|
|
textEnd
|
|
EndP
|
|
|
|
|
|
*******************************************************************************
|
|
*
|
|
* InstallMyRequestProc
|
|
*
|
|
* AcceptRequests(@reqProcName, MMStartUp, ffRequestProc);
|
|
*
|
|
*******************************************************************************
|
|
InstallMyRequestProc proc export
|
|
import ffRequestProc
|
|
|
|
pushlong #reqProcName
|
|
pha
|
|
_MMStartUp
|
|
pushlong #ffRequestProc
|
|
_AcceptRequests
|
|
rtl
|
|
|
|
reqProcName str 'Apple~FindFile~1.1~'
|
|
|
|
EndP
|
|
|
|
*******************************************************************************
|
|
*
|
|
* ffRequestProc
|
|
*
|
|
* This is Find File's Request Procedure, installed by AcceptRequests.
|
|
*
|
|
* We watch for systemSaysMenuKey(Command-F) and open ourselves.
|
|
*
|
|
*******************************************************************************
|
|
ffRequestProc PROC export
|
|
|
|
oldDPage equ 1
|
|
RTL1 equ oldDPage+2
|
|
DataOut equ RTL1+3
|
|
DataIn equ DataOut+4
|
|
Request equ DataIn+4
|
|
Result equ Request+2
|
|
|
|
phd
|
|
tsc
|
|
tcd
|
|
|
|
phb
|
|
phk
|
|
plb
|
|
|
|
lda <Request
|
|
cmp #systemSaysMenuKey
|
|
bne @notMenuKey
|
|
|
|
jsr handleMenuKey
|
|
ror <Result
|
|
|
|
@notMenuKey plb
|
|
|
|
pld
|
|
lda 2,s
|
|
sta 12,s
|
|
lda 1,s
|
|
sta 11,s
|
|
ply
|
|
ply
|
|
ply
|
|
ply
|
|
ply
|
|
rtl
|
|
|
|
*******************************************************************************
|
|
*
|
|
* handleMenuKey
|
|
*
|
|
* Respond to a systemSaysMenuKey request.
|
|
*
|
|
* dataIn = pointer to task record as passed to MenuKey
|
|
*
|
|
* dataOut:
|
|
* +000: recvCount (filled in by Tool Locator)
|
|
*
|
|
* Return with SEC if we handled the request.
|
|
*
|
|
*******************************************************************************
|
|
import ffMenuItemID
|
|
handleMenuKey ldy #oModifiers
|
|
lda [<dataIn],y
|
|
and #appleKey+shiftKey+optionKey+controlKey+keyPad
|
|
cmp #appleKey
|
|
bne @notMe
|
|
|
|
ldy #oMessage
|
|
lda [<dataIn],y
|
|
and #$00df
|
|
cmp #'F' ;Command-F = our key equivalent
|
|
bne @notMe
|
|
|
|
pha ;space for OpenNDA result
|
|
lda ffMenuItemID
|
|
pha
|
|
_OpenNDA
|
|
pla ;ignore
|
|
|
|
sec ;accept the request
|
|
rts
|
|
|
|
@notMe clc
|
|
rts
|
|
|
|
EndP
|
|
|
|
|
|
;\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
|
|
;
|
|
; Equates
|
|
;
|
|
;\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
|
|
;
|
|
|
|
MenuItemPtr equ 36 ;This is the offset to menu mgr's direct page
|
|
; ;variable "itemptr"
|
|
y1 equ 0
|
|
x1 equ y1+2
|
|
y2 equ x1+2
|
|
x2 equ y2+2
|
|
|
|
ItemHeight equ 12
|
|
|
|
;
|
|
; ------ MENU record -----------------------------------------
|
|
;
|
|
MenuID equ 0 Menu's ID number.
|
|
MenuWidth equ MenuID+2 Width of menu.
|
|
MenuHeight equ MenuWidth+2 Height of menu.
|
|
MenuProc equ MenuHeight+2 Menu's definition procedure.
|
|
MenuFlag equ MenuProc+4 Bit flags.
|
|
MenuRes equ MenuFlag+1 Future expansion (makes record even).
|
|
NumOfItems equ MenuRes+1 Number of items in the menu
|
|
TitleWidth equ NumOfItems+2 Width of menu's title.
|
|
TitleName equ TitleWidth+2 Pointer to menu's title text.
|
|
|
|
MenuCache equ TitleName+4 Handle of menu's cache.
|
|
ItemList equ MenuCache+4 Array of items in menu.
|
|
MENUSIZE equ ItemList Size of menu record with no items.
|
|
|
|
;
|
|
; ------ ITEM record -----------------------------------------
|
|
;
|
|
ItemID equ 0 Item's ID number, zero = last item.
|
|
ItemChar equ ItemID+2 Keyboard equvalent, display in item.
|
|
ItemAltChar equ ItemChar+1 Alternate keyboard equvalent, not shown.
|
|
ItemCheck equ ItemAltChar+1 Item's mark.
|
|
ItemFlag equ ItemCheck+2 Bit flags.
|
|
ItemName equ ItemFlag+2 Pointer to item's text.
|
|
ITEMSIZE equ ItemName+4 Size of ITEM record.
|
|
|
|
ItemFlag2 equ 0 control attributes of structure
|
|
ItemTitleRef equ ItemFlag2+2 reference to item name
|
|
ItemIconRef equ ItemTitleRef+4 reference to icon associated with item
|
|
|
|
ItemStructSize equ ItemIconRef+4 size of structure
|
|
|
|
MaxEntries equ 200
|
|
MaxPerLevel equ 1
|
|
|
|
; this used to save some room
|
|
|
|
PushLongVolPopup Proc
|
|
plx
|
|
lda >VolPopup+2
|
|
pha
|
|
lda >VolPopup
|
|
pha
|
|
phx
|
|
rts
|
|
EndP
|
|
|
|
;------------------------------------------------------------------
|
|
;
|
|
; GSOStoPString
|
|
;
|
|
; Converts a GS/OS output string to a pstring.
|
|
;
|
|
; IN: ptr to dest pstring:LONG (Destination)
|
|
; ptr to GSOS output string:LONG (Source)
|
|
;
|
|
; OUT: dest has been converted to a pstring
|
|
;
|
|
;------------------------------------------------------------------
|
|
GSOStoPString PROC EXPORT
|
|
i equ 1
|
|
oldDPage equ i+2
|
|
theRTL equ oldDPage+2
|
|
Source equ theRTL+3
|
|
Dest equ source+4
|
|
|
|
phd
|
|
pha ; make room for the data
|
|
tsc
|
|
tcd ; set our new direct page...
|
|
;
|
|
; Start by getting the proper length into i and dest
|
|
lda [<source] ; its the first word of the source
|
|
cmp #$0100 ; is it too large???
|
|
blt @SizeOK ; size is ok,
|
|
lda #$00FF ; else make it smaller
|
|
@SizeOK sta <i ; save the size...
|
|
sta [<Dest] ; and save the size in our pstring
|
|
; now bump the source pointer by one so we can use the same offset all the time
|
|
inc <source
|
|
bne @1
|
|
inc <source+2
|
|
@1
|
|
; Now start the copy
|
|
sep #$20
|
|
Longa Off ; do it a byte at a time...
|
|
ldy <i ; get our index
|
|
@CopyLoop lda [<source],y ; get a source byte
|
|
sta [<dest],y ; and save it
|
|
dey ; lower the count by 1
|
|
bne @CopyLoop ; loop till zero
|
|
; Now that we are all copied clean up after ourselves and leave
|
|
plx ; pull off the crap
|
|
pld ; pull off the direct page
|
|
pla ; save the return address
|
|
ply ; NOTE: A still in short mode
|
|
|
|
plx ; discard the input parms
|
|
plx
|
|
plx
|
|
plx
|
|
|
|
phy ; put the return address back
|
|
pha
|
|
rep #$20 ; turn long <A> back on
|
|
longa On
|
|
lda #0
|
|
clc ; exit like a tool call
|
|
rtl ; and leave
|
|
EndP
|
|
|
|
;---------------------------------------------------------------------------
|
|
;
|
|
; Global record for use with the popup menu stuff and disk switch stuff.
|
|
;
|
|
;---------------------------------------------------------------------------
|
|
popUpGlobals record
|
|
|
|
Count ds.w 1 ; stores the number of items in the menu
|
|
MenuItemTemplate
|
|
Version dc.w 0 ; must be zero
|
|
MyItemID ds.w 1
|
|
dc.b 0 ; ItemChar, no key equivs...
|
|
dc.b 0 ; ItemAltChar
|
|
dc.w 0 ; ItemCheck
|
|
dc.w $4520 ; bits 9 and 10 describe the item struct.
|
|
; ; ItemFlag, XOR hiliting, title is a handle
|
|
ItemStruct ds.l 1 ; This will be a handle to the volume name
|
|
|
|
;
|
|
; ---- GS/OS parameter block definitions --------------
|
|
;
|
|
|
|
SearchDevNum ds.w 1 ; Device number that was last searched (22-May-91 MSD)
|
|
|
|
DInfoPBlock dc.w 8 ; pcount
|
|
DevNum ds.w 1 ; device number
|
|
dc.l DevNameBuffer ; pointer to buffer to store device name
|
|
Characteristics ds.w 1 ; characteristics
|
|
ds.l 1 ; totalBlocks
|
|
ds.w 1 ; slotnum
|
|
ds.w 1 ; unitnum
|
|
ds.w 1 ; version
|
|
DeviceID ds.w 1 ; deviceID
|
|
|
|
VolumePBlock dc.w 2 ; pcount
|
|
dc.l DevName ; device name (GS/OS input string)
|
|
dc.l VolNameBuffer ; pointer to buffer to store volume name
|
|
|
|
|
|
DevNameBuffer dc.w 35 ; word length count
|
|
DevName ds.b 35 ; buffer to store device name
|
|
|
|
VolNameBuffer dc.w 35 ; word length count
|
|
VolumeName ds.b 35 ; buffer to store volume name
|
|
|
|
GetVolNameFlag ds.W 1 ; flag for get vol name...
|
|
|
|
DStatusPBlock dc.W 5 ; pCount
|
|
DStatDevNum ds.W 1 ; device number
|
|
dc.W 0 ; status code
|
|
dc.L StatusList ; status info returned here
|
|
dc.L $00000002 ; request count, no. of bytes to return
|
|
ds.L 1 ; amount of info actually returned
|
|
StatusList
|
|
StatusWord ds.W 1 ; status word returned for device
|
|
|
|
NotifyPBlock dc.w 1 ; pCount
|
|
theRoutine ds.L 1 ; the notificaton proc
|
|
|
|
DiskEject equ $0010
|
|
|
|
DeviceSwitched ds.w 1
|
|
DeviceInserted ds.w 1
|
|
|
|
theName ds.L 1
|
|
|
|
StaticDeviceTable ds.B 128 ;table of devices not to make DStatus call on.
|
|
|
|
|
|
EndR
|
|
|
|
|
|
;==============================================================================
|
|
;
|
|
; PollDevices
|
|
;
|
|
; This routine just polls all devices making DStatus calls on them, trying to
|
|
; trigger a disk switch event. If one occurs then GS/OS calls my routine
|
|
; NotificationPROC to handle the event.
|
|
;
|
|
;==============================================================================
|
|
PollDevices PROC EXPORT
|
|
Import ServiceDiskSwitch
|
|
|
|
with PopUpGlobals
|
|
|
|
phb
|
|
phk
|
|
plb
|
|
|
|
*** added 23-Apr-91 DAL -- limit polling frequency to 1.5 seconds
|
|
jsr GetTick
|
|
sec
|
|
sbc prevPollTick
|
|
cmp #180
|
|
bcc DoNothing
|
|
*** end of 23-Apr-91 DAL
|
|
|
|
stz DStatDevNum ;reset the device number so we can search from begining
|
|
|
|
BigLooper inc DStatDevNum ;check next device
|
|
lda DStatDevNum ;Check our table to see if this device even needs to be
|
|
cmp #65 ;polled. Non-removable devices and 5.25s are not polled.
|
|
bcs @done ;exit when we reach our 64 device limit
|
|
asl a
|
|
tax
|
|
lda StaticDeviceTable-2,x
|
|
bmi BigLooper
|
|
|
|
_DStatusGS DStatusPBlock
|
|
bcc BigLooper ;loop until we run out of devices
|
|
|
|
@done
|
|
*** added 23-Apr-91 DAL
|
|
jsr GetTick
|
|
sta prevPollTick
|
|
*** end of 23-Apr-91 DAL
|
|
|
|
DoNothing plb
|
|
|
|
rtl
|
|
|
|
prevPollTick dc.w 0
|
|
|
|
GetTick pha
|
|
pha
|
|
_TickCount
|
|
pla
|
|
plx
|
|
rts
|
|
|
|
ENDP
|
|
|
|
|
|
;==============================================================================
|
|
;
|
|
; NotificationPROC
|
|
;
|
|
; This is the routine that gets installed into GS/OS's notification queue.
|
|
; NumVolumes is incremented or decremented depending on the disk switch. We
|
|
; save off the device number of the disk that got switched and the flag that
|
|
; tells us whether an insertion or ejection occurred.
|
|
; We pay particular attention to disk ejects that occurred on the currently
|
|
; displayed volume.
|
|
;
|
|
; On entry: Acc = device number
|
|
; event_code = bit 4 set = eject
|
|
; bit 3 set = insert
|
|
;
|
|
;==============================================================================
|
|
NotificationPROC PROC EXPORT
|
|
with PopupGlobals
|
|
|
|
Reserved1 ds.L 1 ;link to next task in queue
|
|
Reserved2 ds.W 1
|
|
Signature dc.W $A55A
|
|
Event_flags dc.L $00000018 ;want disk inserts/ejects
|
|
Event_code ds.L 1 ;curent event code will be put here by GS/OS
|
|
|
|
with PopUpGlobals
|
|
|
|
phk ;first set the data bank correctly
|
|
plb
|
|
|
|
cmp #65 ; beyond our 64-device limit?
|
|
bcs @done ; yes, just ignore it
|
|
|
|
tay ; move device number of disk switched device into y-reg
|
|
asl a
|
|
tax
|
|
lda StaticDeviceTable-2,x
|
|
bmi @Done ; ignore 5.25's and non-removeable media drives
|
|
|
|
lda Event_Code ;save flag that tells us whether an insert or eject happened
|
|
lsr a
|
|
lsr a
|
|
lsr a
|
|
and #%0011
|
|
ora StaticDeviceTable-2,x
|
|
sta StaticDeviceTable-2,x
|
|
sty DeviceSwitched ;set flag to show that we've been through here
|
|
;list is automatically redrawn on disk insertion.
|
|
@Done rtl
|
|
|
|
ENDP
|
|
|
|
|
|
|
|
;==================================================
|
|
; This routine inserts the notification routine
|
|
; into the GS/OS notification queue to get
|
|
; informed of disk switch events
|
|
;==================================================
|
|
CallNotifyProc Proc Export
|
|
with PopupGlobals
|
|
|
|
phb
|
|
phk
|
|
plb
|
|
|
|
lda #NotificationPROC
|
|
sta theRoutine
|
|
lda #^NotificationPROC
|
|
sta theRoutine+2
|
|
|
|
_AddNotifyProcGS NotifyPBlock
|
|
|
|
plb
|
|
|
|
rtl
|
|
|
|
EndP
|
|
|
|
;==================================================
|
|
; This routine removes the notification routine
|
|
; from the GS/OS notification queue
|
|
;==================================================
|
|
CallDelNotifyProc Proc Export
|
|
with PopupGlobals
|
|
|
|
phb
|
|
phk
|
|
plb
|
|
|
|
_DelNotifyProcGS NotifyPBlock
|
|
|
|
plb
|
|
|
|
rtl
|
|
|
|
EndP
|
|
|
|
;===========================================================
|
|
;
|
|
;===========================================================
|
|
ServiceDiskSwitch Proc Export
|
|
with PopupGlobals
|
|
|
|
phb
|
|
phk
|
|
plb
|
|
|
|
lda DeviceSwitched ; check if there was a disk switch
|
|
bne gotSwitch
|
|
brl exit ; that was easy!
|
|
gotSwitch
|
|
pha ; save current menu bar on the stack
|
|
pha
|
|
_GetMenuBar
|
|
|
|
jsr PushLongVolPopup ; set new menu bar to popup control
|
|
_SetMenuBar
|
|
|
|
stz DeviceInserted ; init this
|
|
|
|
ldx #0 ; now we walk the list, looking for ANY disk switch
|
|
@switch_loop
|
|
lda StaticDeviceTable,x
|
|
bmi @skip_it ; skip over 5.25's and non-removables
|
|
beq @skip_it ; no eject/insert here!
|
|
phx ; save index
|
|
txa ; convert to device number
|
|
lsr a
|
|
inc a ; adjust for 1-based array
|
|
sta DeviceSwitched ; set this for the update_menu subroutine
|
|
jsr update_menu ; go update the popup
|
|
plx ; retrieve index
|
|
lda StaticDeviceTable,x ;get the eject/insert bits
|
|
and #%0001 ; was the device inserted?
|
|
beq @no_insert ; no...
|
|
lda DeviceSwitched ; else save the device number
|
|
sta DeviceInserted ; so we can update the menu properly
|
|
@no_insert
|
|
stz StaticDeviceTable,x
|
|
@skip_it
|
|
inx ; step to next device
|
|
inx
|
|
cpx #128 ; maximum of 64 devices in table
|
|
bcc @switch_loop
|
|
|
|
; now that we've handled all the ejects/inserts, update the displayed menu
|
|
|
|
lda DeviceInserted ;the last device number that was inserted
|
|
bne @use_this
|
|
pha ; get the current setting
|
|
jsr PushLongVolPopup
|
|
_GetCtlValue
|
|
pla
|
|
cmp DeviceSwitched ; was the ejected device currently set?
|
|
beq @reset ; if so, reset menu to first device
|
|
@use_this
|
|
pha
|
|
jsr PushLongVolPopup
|
|
_SetCtlValue ; set popup result to name of newly inserted disk
|
|
|
|
pha ; now let's make sure it was a valid value
|
|
jsr PushLongVolPopup
|
|
_GetCtlValue
|
|
pla
|
|
bne @was_valid
|
|
@reset
|
|
pha ; space for result
|
|
pea 1 ; menu id
|
|
_CountMItems ; is there anything in the menu?
|
|
pla
|
|
beq @was_valid ; nope, just leave it set to 0
|
|
|
|
jsr SetPopup
|
|
@was_valid
|
|
pea 0 ; width
|
|
pea 0 ; height
|
|
pea 1 ; ID of menu
|
|
_CalcMenuSize
|
|
|
|
_SetMenuBar ; restore original menu bar
|
|
exit
|
|
stz DeviceSwitched ; set up for next time through the loop
|
|
|
|
plb
|
|
|
|
rtl
|
|
|
|
update_menu
|
|
;
|
|
; ----- Handle disk ejection -----------------------------------
|
|
;
|
|
doEject
|
|
|
|
; ----- Get rid of the memory for the item struct assoc. with this item
|
|
;
|
|
DPage equ 1
|
|
thePtr equ DPage+2
|
|
theHandle equ thePtr+4
|
|
|
|
lda #0 ; space for result
|
|
pha
|
|
pha
|
|
lda DeviceSwitched
|
|
pha ; that's our menu item number
|
|
ldx #$4A0F
|
|
jsl $E10000 ; GetItemStruct
|
|
bcs doInsert ; it wasn't in the menu to begin with!
|
|
lda 1,s ; was the item really there?
|
|
ora 3,s
|
|
beq doInsert ; no...
|
|
|
|
pha ; space for derefing itemstruct so we can get at
|
|
pha ; the handle to the item's name
|
|
phd
|
|
tsc
|
|
tcd
|
|
|
|
lda [<theHandle] ; deref handle to itemstruct
|
|
sta <thePtr
|
|
ldy #2
|
|
lda [<theHandle],y
|
|
sta <thePtr+2
|
|
|
|
ldy #ItemTitleRef+2 ; get rid of the handle we got for the item's name
|
|
lda [<thePtr],y
|
|
pha
|
|
ldy #ItemTitleRef
|
|
lda [<thePtr],y
|
|
pha
|
|
_DisposeHandle
|
|
|
|
pld
|
|
pla ; remove the ptr to itemstruct
|
|
pla
|
|
_DisposeHandle ; now get rid of handle to itemstruct itself (still on stack)
|
|
|
|
|
|
PushWord DeviceSwitched
|
|
_DeleteMItem ; get rid of the device ejected from the popup
|
|
|
|
bra doInsert2
|
|
|
|
;
|
|
; ----- Handle disk insertion -------------------------------------
|
|
;
|
|
doInsert
|
|
pla ;clean up stack from GetMItemStruct call
|
|
pla
|
|
doInsert2
|
|
lda DeviceSwitched
|
|
sta DevNum
|
|
_DInfoGS DInfoPBlock
|
|
bcs errorExit
|
|
_VolumeGS VolumePBlock
|
|
bcs errorExit
|
|
|
|
lda #33 ; size of memory block we want
|
|
jsr GetHandle
|
|
bcs errorExit
|
|
|
|
phx
|
|
pha
|
|
phd ; save original direct page
|
|
|
|
tsc
|
|
tcd ; turn stack into direct page so we can deref handle
|
|
|
|
origD equ 1
|
|
Handle equ origD+2
|
|
|
|
lda [<Handle]
|
|
tax
|
|
ldy #2
|
|
lda [<Handle],y
|
|
pld ; restore direct page
|
|
|
|
pha ; destination of PString
|
|
phx
|
|
PushLong #VolumeName ; GS/OS output string to convert
|
|
jsl GSOStoPString
|
|
|
|
pla ; get handle for volume name off stack and return
|
|
plx ; in a and x registers back to calling program
|
|
|
|
jsr InsertTheItem
|
|
|
|
errorExit
|
|
rts
|
|
|
|
EndP
|
|
|
|
|
|
;===========================================================
|
|
; This routine sets the popup control result to the first
|
|
; menu item in the popup.
|
|
;===========================================================
|
|
SetPopup Proc
|
|
with PopupGlobals
|
|
|
|
OrigD equ 1
|
|
theMenu equ OrigD+2
|
|
|
|
|
|
pea 0 ; space for result
|
|
pea 0 ; space for result
|
|
pea 1 ; menu ID
|
|
_GetMHandle
|
|
phd
|
|
tsc ; turn stack into direct page
|
|
tcd
|
|
|
|
ldy #2
|
|
lda [<theMenu],y
|
|
tax
|
|
lda [<theMenu]
|
|
sta <theMenu
|
|
stx <theMenu+2
|
|
|
|
ldy #ItemList ; offset to first item in the menu
|
|
lda [<theMenu],y ; first word in item record is the item id
|
|
|
|
pld ; restore original direct page
|
|
plx ; remove ptr to popup control
|
|
plx
|
|
|
|
pha ; item ID
|
|
jsr PushLongVolPopup
|
|
_SetCtlValue
|
|
|
|
rts
|
|
|
|
EndP
|
|
|
|
;===========================================================
|
|
; This routine inserts the specified volume name (handle in
|
|
; a & x registers) into the popup menu.
|
|
;===========================================================
|
|
InsertTheItem Proc
|
|
with PopupGlobals
|
|
|
|
phx ; store volume name on stack for now
|
|
pha
|
|
|
|
lda #ItemStructSize
|
|
jsr GetHandle
|
|
bcc @gotMem2
|
|
|
|
_DisposeHandle ; get rid of the handle we just got for the volume name
|
|
sec
|
|
rts
|
|
|
|
@gotMem2 phx
|
|
pha
|
|
stx ItemStruct+2 ; store handle to item struct in our menu item template
|
|
sta ItemStruct
|
|
|
|
theDPage equ 1
|
|
tempPtr equ theDPage+2
|
|
theStruct equ tempPtr+4
|
|
theVolName equ theStruct+4
|
|
|
|
phx ; make space for temporary pointer
|
|
pha
|
|
phd ; save current direct page register
|
|
tsc ; turn stack into direct page
|
|
tcd
|
|
|
|
ldy #2 ; deref handle to the item struct
|
|
lda [<theStruct],y
|
|
tax
|
|
lda [<theStruct]
|
|
sta <theStruct
|
|
stx <theStruct+2
|
|
|
|
; *** Removed 16-Mar-92 DAL, because the Menu Manager takes care of this now
|
|
;
|
|
;; Before we place the volume name into the menu, we must make sure that it isn't so
|
|
;; long that it extends into the down-arrow at the right end of the menu. If it is
|
|
;; too long, we simply reduce the length and add an ellipsis as the last displayable
|
|
;; character.
|
|
;
|
|
; lda [<theVolName],y ; deref handle to volume name
|
|
; sta <tempPtr+2
|
|
; lda [<theVolName]
|
|
; sta <tempPtr
|
|
;@shortened
|
|
; pha ; make space for result
|
|
; pei <tempPtr+2 ; string pointer
|
|
; pei <tempPtr
|
|
; _StringWidth ; how long is this sucker???
|
|
; pla
|
|
; cmp #98 ; too long?
|
|
; bcc @good_length ; nope, we can use it as is
|
|
; sep #$30 ; 8-bit registers
|
|
; longa off
|
|
; longi off
|
|
; lda [<tempPtr] ; get the length
|
|
; dec a ; reduce by 1 character
|
|
; sta [<tempPtr] ; store the new length
|
|
; tay ; index to new last character
|
|
; lda #'É' ; replace with elipsis
|
|
; sta [<tempPtr],y
|
|
; rep #$30 ; back to 16-bit accumulator
|
|
; longa on
|
|
; longi on
|
|
; bra @shortened ; go back and try again
|
|
;
|
|
;@good_length
|
|
|
|
*** 16-Mar-92 DAL -- strip leading colon off the volume name
|
|
ldy #2
|
|
lda [<theVolName],y ; deref handle to volume name
|
|
sta <tempPtr+2
|
|
lda [<theVolName]
|
|
sta <tempPtr
|
|
|
|
ldy #1
|
|
lda [<tempPtr],y
|
|
and #$00ff
|
|
cmp #$003a
|
|
bne @notColon
|
|
|
|
ldx <tempPtr+2
|
|
lda <tempPtr
|
|
clc
|
|
adc #2
|
|
bcc @1
|
|
inx
|
|
@1 phx
|
|
pha ;source = tempPtr+2
|
|
ldx <tempPtr+2
|
|
lda <tempPtr
|
|
inc a
|
|
bne @2
|
|
inx
|
|
@2 phx
|
|
pha ;dest = tempPtr+1
|
|
pea 0 ;size high = 0
|
|
lda [<tempPtr]
|
|
and #$00ff
|
|
dec a
|
|
pha ;size low = pstring length - 1
|
|
_BlockMove
|
|
|
|
lda [<tempPtr]
|
|
dec a
|
|
sta [<tempPtr]
|
|
@notColon
|
|
*** end 16-Mar-92
|
|
|
|
ldy #ItemFlag2
|
|
lda #$8000 ; bit 15 indicates item has an icon associated with it
|
|
sta [<theStruct],y
|
|
ldy #ItemTitleRef ; store item title in its new location
|
|
lda <theVolName
|
|
sta [<theStruct],y
|
|
lda <theVolName+2
|
|
iny
|
|
iny
|
|
sta [<theStruct],y
|
|
|
|
*** use GetSysIcon instead of our local hard-coded icons, 23-Apr-91 DAL
|
|
pha
|
|
pha ;space for GetSysIcon result
|
|
pea 1 ;get a device icon
|
|
lda DeviceID
|
|
pha
|
|
pha
|
|
pha ;auxvalue ignored
|
|
_GetSysIcon
|
|
pla
|
|
ldy #ItemIconRef
|
|
sta [<theStruct],y
|
|
iny
|
|
iny
|
|
pla
|
|
sta [<theStruct],y
|
|
*** end of 23-Apr-91 DAL
|
|
|
|
pld ; turn direct page back into our stack
|
|
tsc ; clean up stack
|
|
clc
|
|
adc #12
|
|
tcs
|
|
|
|
lda DevNum
|
|
sta MyItemID ; set item id to that of the device number
|
|
|
|
pea 0 ; refdesciptor = 0, ptr to item template
|
|
PushLong #MenuItemTemplate
|
|
pea $FFFF ; insert at end of list
|
|
pea 1
|
|
_InsertMItem2
|
|
|
|
clc
|
|
|
|
rts
|
|
|
|
EndP
|
|
|
|
;----------------------------------------------------------------------
|
|
;
|
|
;----------------------------------------------------------------------
|
|
AddVolumeMenu Proc Export
|
|
;
|
|
; Stack for this call...
|
|
tempDeref equ 1
|
|
tempHandle equ tempDeref+4
|
|
MyRefNum equ tempHandle+4
|
|
MyPathLevel equ MyRefNum+2
|
|
i equ MyPathLevel+2
|
|
lastDevNum equ i+2
|
|
OldDPage equ lastDevNum+2
|
|
OldDB equ OldDPage+2
|
|
theRTL equ OldDB+1
|
|
FrameSize equ theRTL
|
|
;
|
|
; Begin by setting up our stack frame......
|
|
|
|
phb
|
|
phd
|
|
tsc
|
|
sec
|
|
sbc #FrameSize
|
|
tcd
|
|
tcs
|
|
|
|
phk
|
|
plb
|
|
; First, build a list of volume names
|
|
;END
|
|
|
|
jsr CreatePopUp ; call NewControl2 to create, and the add all
|
|
; ; the names of all volumes on-line into the popup
|
|
; end; {procedure}
|
|
EndVolMenu
|
|
tdc ; unlink our local frame
|
|
clc
|
|
adc #FrameSize
|
|
tcs ; make it our current stack
|
|
pld ; recover the orihginal dpage
|
|
plb
|
|
RTL
|
|
|
|
|
|
;===========================================================
|
|
;
|
|
; CreatePopup
|
|
;
|
|
; This routine creates an empty popup control, makes
|
|
; the popup control the current menubar, then adds
|
|
; all the names of the volumes on-line into the popup
|
|
; and then restores the original menubar.
|
|
;
|
|
;===========================================================
|
|
CreatePopup
|
|
_WaitCursor
|
|
|
|
pha ; space for result from NewControl2
|
|
pha
|
|
PushLong >idleWind ; push grafport ptr
|
|
PushWord #0 ; input ref is a pointer to a single item template
|
|
PushLong #PopUpControl1
|
|
_NewControl2
|
|
pla
|
|
sta >VolPopUp
|
|
pla
|
|
sta >VolPopUp+2
|
|
|
|
pha ; space for handle to menubar
|
|
pha
|
|
_GetMenuBar ; save current menubar, leave handle on stack
|
|
|
|
jsr PushLongVolPopup ; set menubar to popup menu so we can
|
|
_SetMenuBar ; operate on the popup
|
|
|
|
jsr AddItems ; find all volumes on-line and insert into popup
|
|
|
|
pea 0 ; calculate height and width of newly formed
|
|
pea 0 ; volumes popup
|
|
pea 1 ; ID of menu to calculate
|
|
_CalcMenuSize
|
|
|
|
_SetMenuBar ; Restore original menubar
|
|
|
|
_InitCursor
|
|
|
|
rts
|
|
|
|
; ---------------------------------------------------------------------
|
|
; NewControl2 template for a popup control.
|
|
; ---------------------------------------------------------------------
|
|
PopUpControl1 dc.w 9 ; pcount
|
|
dc.l 1 ; ID of control
|
|
dc.w 5+1,10,18,220 ; rectangle for popup control (8-Dec-91 DAL)
|
|
dc.l $87000000 ; popup procref
|
|
dc.w $0060 ; type 2 popup, don't hilite title, {right justify title}
|
|
dc.w $10A0 ; more flags, fctlProcNotPtr, fDrawIconInResult, fDrawArrowIcon
|
|
dc.l 0 ; no refcon
|
|
dc.w 0 ; title width
|
|
dc.l PopupMenu1 ; ptr to menu item list
|
|
dc.w 1 ; initial value of popup selection
|
|
|
|
PopupMenu1 dc.w 0 ; version, must be zero
|
|
xMenuID dc.w 1 ; id of popup menu
|
|
dc.w $0000 ; menu flag
|
|
dc.l PopupTitle1 ; title of popup menu
|
|
dc.l 0000 ; no items, empty menu
|
|
|
|
PopupTitle1 str 'Disks: '
|
|
|
|
;==================================================
|
|
;
|
|
; AddItems
|
|
;
|
|
; This routine calls routine GetNextVolume, which
|
|
; returns the next volume that is online. This
|
|
; volume is then inserted into the "volumes" popup.
|
|
;
|
|
;==================================================
|
|
AddItems
|
|
With popUpGlobals
|
|
|
|
; First we zero out the device table
|
|
|
|
ldx #128
|
|
@ZeroLoop stz StaticDeviceTable-2,x
|
|
dex
|
|
dex
|
|
bne @ZeroLoop
|
|
|
|
stz DevNum ; start looking starting at DevNum = 1
|
|
|
|
;
|
|
; ----------- First make sure the popup is empty -------------------------
|
|
;
|
|
pha ; space for result
|
|
pea 1 ; ID of menu we want
|
|
_CountMItems
|
|
pla
|
|
sta Count
|
|
|
|
beq @PopupEmpty
|
|
|
|
pea 0 ; new value of popup selection
|
|
jsr PushLongVolPopup ; this erases current result
|
|
_SetCtlValue
|
|
|
|
@DeleteAnother pea $FFFF ; to delete last item
|
|
_DeleteMItem
|
|
|
|
dec Count
|
|
lda Count
|
|
bne @DeleteAnother
|
|
|
|
pea 0 ; width
|
|
pea 0 ; height
|
|
pea 1 ; ID of menu
|
|
_CalcMenuSize
|
|
|
|
lda >MyID
|
|
ora #$0600
|
|
pha
|
|
_DisposeAll ; get rid of all other handles allocated for volume names
|
|
|
|
@PopupEmpty lda #0
|
|
sta >getVolNameFlag
|
|
InsertNext
|
|
jsr GetNextVolume ; returns with a & x set to ptr to the volume name
|
|
bcs NoMoreVolumes
|
|
|
|
jsr InsertTheItem
|
|
bcc InsertNext
|
|
|
|
NoMoreVolumes
|
|
jsr SetPopup ; sets result of popup to first menu item
|
|
|
|
stz DeviceSwitched
|
|
|
|
rts
|
|
|
|
|
|
;==================================================
|
|
;
|
|
; GetNextVolume
|
|
;
|
|
; This routine returns the volume name of the next
|
|
; volume that is on-line.
|
|
;
|
|
; Each time into this routine we bump the device
|
|
; number to use as input to _DInfo so we always get
|
|
; the next device. _DInfo returns the device name
|
|
; which in turn is used as input to _Volume which
|
|
; returns the volume name.
|
|
;
|
|
; For each new device that we ecounter we get a new
|
|
; handle to store this name.
|
|
;
|
|
; When we finally get error $11(invalid device number)
|
|
; from _DInfo we know there are no more devices.
|
|
; We set the carry upon exit from this routine when
|
|
; we encounter this error.
|
|
;
|
|
; GetNextVolume always returns either a valid volume
|
|
; name or carry set which means no more volumes found.
|
|
;
|
|
; OUT: a = low word of handle to volume
|
|
; x = high word of handle to volume
|
|
;
|
|
;==================================================
|
|
export GetNextVolume
|
|
GetNextVolume
|
|
with popUpGlobals
|
|
|
|
import GSOStoPString
|
|
|
|
|
|
NextDevice inc DevNum ; bump the device number to search
|
|
|
|
_DInfoGS DInfoPBlock ; make GS/OS call
|
|
bcc NoError
|
|
|
|
cmp #$11 ; check for "invalid device number" error
|
|
; if we get this then we're done
|
|
bne NoError
|
|
brl NoMoreDevices
|
|
NoError
|
|
lda DeviceID
|
|
bne MakeVolumeCall
|
|
|
|
;
|
|
; ----- We've got a 5.25 drive -----------------------------------------
|
|
;
|
|
lda DevNum
|
|
sta DStatDevNum
|
|
_DStatusGS DStatusPBlock
|
|
|
|
lda StatusWord
|
|
and #$0010 ; Is there a disk in the 5.25 drive
|
|
beq NextDevice ; If OS says there is then the drive is on-line, else...
|
|
|
|
jsr InsertIntoList
|
|
|
|
lda #DevName
|
|
sta theName
|
|
lda #^DevName
|
|
sta theName+2
|
|
bra doNewHandle
|
|
|
|
MakeVolumeCall
|
|
_VolumeGS VolumePBlock
|
|
bcs NextDevice ; if we get an error then we need to go to next device
|
|
lda #VolumeName
|
|
sta theName
|
|
lda #^VolumeName
|
|
sta theName+2
|
|
|
|
lda Characteristics
|
|
and #$0004 ; Check if this device contains removable media
|
|
bne doNewHandle
|
|
jsr InsertIntoList
|
|
|
|
doNewHandle
|
|
lda #33 ; size of memory block we want
|
|
|
|
jsr GetHandle ; a = low word of handle, x = high word
|
|
bcs NoMoreDevices ; get out if we couldn't get the memory to store the name
|
|
|
|
phx
|
|
pha
|
|
phd ; save original direct page
|
|
|
|
tsc
|
|
tcd ; turn stack into direct page so we can deref handle
|
|
|
|
origD equ 1
|
|
Handle equ origD+2
|
|
|
|
lda [<Handle]
|
|
tax
|
|
ldy #2
|
|
lda [<Handle],y
|
|
pld ; restore direct page
|
|
|
|
pha ; destination of PString
|
|
phx
|
|
PushLong theName ; GS/OS output string to convert
|
|
jsl GSOStoPString
|
|
|
|
pla ; get handle for volume name off stack and return
|
|
plx ; in a and x registers back to calling program
|
|
|
|
clc ; no error
|
|
rts
|
|
|
|
NoMoreDevices sec
|
|
rts
|
|
|
|
EndP
|
|
|
|
;==================================================
|
|
;
|
|
; GetHandle
|
|
;
|
|
; IN: a = number of bytes to allocate
|
|
;
|
|
; OUT: carry clear is handle allocated, a+x = handle
|
|
; carry set if error, y = error returned by Mem Mgr
|
|
;
|
|
;==================================================
|
|
GetHandle PROC
|
|
with popUpGlobals
|
|
|
|
pha ; space for returned handle
|
|
pha
|
|
pea 0 ; high word of size
|
|
pha ; low word of size, passed as input to routine
|
|
lda >MyID
|
|
ora #$0600 ; set ID to $x1xx so we can get rid of this memory easily
|
|
pha
|
|
pea 0 ; no attributes
|
|
pha
|
|
pha
|
|
_NewHandle
|
|
tay
|
|
pla ; a = low word
|
|
plx ; x = high word
|
|
|
|
rts
|
|
|
|
|
|
EndP
|
|
|
|
|
|
|
|
;------------------------------------------------------------------
|
|
;
|
|
; InsertIntoList
|
|
;
|
|
; Inserts device into list of non-removable media devices. This is
|
|
; the list that is used to determine whether a device should be
|
|
; polled for disk switch or not. (i.e. should we make the DStatus
|
|
; call on the device) Apple 5.25 drives are also included in this
|
|
; list.
|
|
;
|
|
;------------------------------------------------------------------
|
|
InsertIntoList PROC
|
|
with PopUpGlobals
|
|
|
|
lda DevNum ;use device number as index into this list
|
|
cmp #65 ;beyond our 64-device limit?
|
|
bcs @skip_it ;yes, just ignore it
|
|
|
|
asl a
|
|
tax
|
|
lda #$8000
|
|
@StoreIt sta StaticDeviceTable-2,x
|
|
@skip_it
|
|
rts
|
|
|
|
ENDP
|
|
|
|
;------------------------------------------------------------------
|
|
; 22-May-91 MSD Now saves device number that we'll be searching
|
|
; in a separate variable so that we can use it
|
|
; later to display the correct volume icon in the
|
|
; path display for a file.
|
|
;
|
|
;------------------------------------------------------------------
|
|
MakeCurPath Proc Export
|
|
with popUpGlobals
|
|
import GetNextVolume
|
|
;
|
|
OldDPage equ 1
|
|
OldDBank equ OldDPage+2
|
|
theRTL equ oldDBank+1
|
|
theResult equ theRTL+3
|
|
|
|
phb
|
|
phk
|
|
plb
|
|
phd
|
|
tsc
|
|
tcd
|
|
|
|
lda #$FFFF
|
|
sta theResult
|
|
|
|
pha
|
|
jsr PushLongVolPopup
|
|
_GetCtlValue
|
|
pla
|
|
sta SearchDevNum ; remember device number we're searching (22-May-91 MSD)
|
|
sta DevNum
|
|
_DInfoGS DInfoPBlock ; find out the device name
|
|
bcs ErrorExit
|
|
noError
|
|
_VolumeGS VolumePBlock ; now get the volume name
|
|
bcs ErrorExit
|
|
|
|
PushLong #CurrentDirPath
|
|
PushLong #VolumeName
|
|
jsl GSOStoPString ; convert to pstring
|
|
|
|
gotPath
|
|
lda >CurrentDirPath
|
|
inc a
|
|
sta >CurrentDirPath
|
|
and #$00FF
|
|
tax
|
|
lda #':'
|
|
sta >CurrentDirPath,x
|
|
exit pld
|
|
plb
|
|
rtl
|
|
|
|
ErrorExit
|
|
stz theResult
|
|
|
|
PushLong #theMessage
|
|
jsl SetMessage
|
|
bra exit
|
|
|
|
theMessage dc.B textEnd-textStart
|
|
textStart dc.B $01,$4A,$00,$00
|
|
dc.B 'Problems reading the disk.'
|
|
textEnd
|
|
EndP
|
|
|
|
|
|
*******************************************************************************
|
|
*
|
|
* MakeSureExtraToolsAreHere -- load and start other tools as needed
|
|
*
|
|
*******************************************************************************
|
|
MakeSureExtraToolsAreHere proc export
|
|
|
|
*** removed 26-Jan-93 SS -- not needed in 6.0
|
|
; pea 0
|
|
; _QDAuxStatus
|
|
; pla
|
|
; bne @ok
|
|
;
|
|
;@again pea $0012 ;tool number = QD Aux
|
|
; pea $0304 ;version 3.4
|
|
; _LoadOneTool
|
|
; bcs @again
|
|
;
|
|
; _QDAuxStartUp
|
|
;@ok
|
|
*** end 26-Jan-93
|
|
|
|
*** added 24-Sep-91 DAL -- make sure List Manager is here, too
|
|
pea 0
|
|
_ListStatus
|
|
pla
|
|
bne @ListOK
|
|
|
|
@listAgain pea $001C ;tool number = List Manager
|
|
pea $0303 ;version 3.3
|
|
_LoadOneTool
|
|
bcs @listAgain
|
|
|
|
_ListStartUp
|
|
@ListOK
|
|
*** end 24-Sep-91
|
|
rtl
|
|
|
|
|
|
EJECT
|
|
*******************************************************************************
|
|
*
|
|
GetUpTextFromLE PROC Export
|
|
*
|
|
* Description: This routine returns a Pascal string from a line edit item
|
|
* that is all upper case. All you do is pass the LERechandle
|
|
* and I do the rest!
|
|
*
|
|
*
|
|
* Inputs: theLERecHandle:Handle
|
|
* theStr:Str32;
|
|
*
|
|
* Outputs: none
|
|
*
|
|
* External Refs: none
|
|
*
|
|
* Entry Points: none
|
|
*
|
|
*******************************************************************************
|
|
;
|
|
; Stack frame for this call...
|
|
tempPtr equ 1
|
|
oldDPage equ tempPtr+4
|
|
theRTL equ oldDPage+2
|
|
theStr equ theRTL+3
|
|
theLERecHandle equ theStr+4
|
|
;
|
|
; First link a stack frame...
|
|
phd
|
|
pha
|
|
pha
|
|
tsc
|
|
tcd
|
|
|
|
;
|
|
; Now get the length of the text we are going to use...
|
|
pha
|
|
pei theLERecHandle+2
|
|
pei theLERecHandle
|
|
_LEGetTextLen
|
|
tax
|
|
pla
|
|
bcc @cont
|
|
brl Anerror
|
|
|
|
@Cont sta [theStr] ; save the length in the string...
|
|
beq Done ; if its zero, then we are done!
|
|
;
|
|
; Now get the string handle from line edit...
|
|
pha
|
|
pha
|
|
pei theLERecHandle+2
|
|
pei theLERecHandle
|
|
_LEGetTextHand
|
|
tax
|
|
pla
|
|
sta tempPtr
|
|
pla
|
|
sta tempPtr+2
|
|
bcc @Cont1
|
|
brl AnError
|
|
;
|
|
; Now that we have all the data move it into the string!
|
|
@Cont1
|
|
ldy #2 ; deref the handle
|
|
lda [tempPtr],y
|
|
tax
|
|
lda [tempPtr]
|
|
bne @ItsOK
|
|
dec a
|
|
dex
|
|
bra @cont3
|
|
@ItsOK
|
|
dec a ; remember to remember the based data
|
|
@Cont3 sta tempPtr
|
|
stx tempPtr+2 ; we now have a pointer to that data!
|
|
|
|
lda [theStr]
|
|
tay ; init our counter...
|
|
sep #$20
|
|
longa Off
|
|
@Loop
|
|
lda [tempPtr],y
|
|
cmp #'A'
|
|
blt @Loop10
|
|
cmp #'Z'+1
|
|
bge @Loop10
|
|
ora #$20
|
|
@Loop10 sta [theStr],y
|
|
dey
|
|
bne @Loop
|
|
rep #$20
|
|
longA On
|
|
Done
|
|
pla ; unlink the stack
|
|
pla
|
|
pld
|
|
sep #$20
|
|
longa Off
|
|
pla
|
|
ply
|
|
|
|
plx
|
|
plx
|
|
plx
|
|
plx
|
|
|
|
phy
|
|
pha
|
|
rep #$20
|
|
longa On
|
|
RTL
|
|
AnError txa
|
|
sta AsmToolErr
|
|
bra Done
|
|
EndP
|
|
|
|
EJECT
|
|
*******************************************************************************
|
|
*
|
|
CreatePathList PROC Export
|
|
with PopupGlobals
|
|
*
|
|
* Description: This routine will take a pointer to a string and turn it into
|
|
* a list to be displayed by the list manager.
|
|
*
|
|
*
|
|
* Inputs: theStr:str255
|
|
*
|
|
* Outputs: None
|
|
*
|
|
* External Refs:
|
|
*
|
|
* Entry Points:
|
|
*
|
|
*******************************************************************************
|
|
; My member record for use with the passed member record
|
|
MemString equ 0 ; 4
|
|
MemFlag equ MemString+4 ; 6
|
|
MemFullName equ MemFlag+2 ; 10
|
|
MemType equ MemFullName+4 ; 12
|
|
MemAux equ MemType+2 ; 16
|
|
MemEOF equ MemAux+4 ; 20 member record is 20 bytes...
|
|
MemRecSize equ MemEOF+4
|
|
;
|
|
;
|
|
tempPtr equ 1
|
|
tempInt equ tempPtr+4
|
|
OldDBank equ tempInt+2
|
|
OldDPage equ OldDBank+1
|
|
theRTL equ OldDPage+2
|
|
theInStr equ theRTL+3
|
|
ThisRtnAux equ $0300 ; subID for all memory used by this routine
|
|
;
|
|
; First thing, get rid of any old pathlist data...
|
|
lda >MyID
|
|
ora #ThisRtnAux
|
|
pha
|
|
_DisposeAll ; dump the old handles
|
|
|
|
phd
|
|
phb
|
|
phk
|
|
plb ; switch to this databank...
|
|
pha
|
|
pha
|
|
pha
|
|
tsc
|
|
tcd ; set up our stack frame...
|
|
;
|
|
; Now clean out my pathname list list...
|
|
ldx #SizeOfPathList-2
|
|
lda #0
|
|
@CleanLoop sta PathList,x
|
|
dex
|
|
dex
|
|
bpl @CleanLoop
|
|
;
|
|
; Now that the path list is all cleaned out, let's create the list of names!
|
|
;
|
|
lda [theInStr] ; set the current length
|
|
and #$00FF
|
|
sta PathLeft
|
|
jsr StripFileName ; strip off the first file name throw it away
|
|
stz <TempInt ; create item number 0!
|
|
@NextName
|
|
; To Add a name to the list, allocate a handle for its file name...
|
|
jsr StripFileName ; get the next level up...
|
|
ldx #0
|
|
pha ; room for result
|
|
pha
|
|
phx ; size of handle
|
|
pha ; <A> has size of handle to get...
|
|
lda >MyID
|
|
ora #ThisRtnAux ; special stack memory
|
|
pha
|
|
pea $4000 ; fixed
|
|
phx
|
|
phx ;
|
|
_NewHandle
|
|
pla
|
|
sta <TempPtr
|
|
pla
|
|
sta <TempPtr+2
|
|
lda [tempPtr]
|
|
tax
|
|
ldy #2
|
|
lda [tempPtr],y
|
|
sta <tempPtr+2
|
|
stx <TempPtr ; deref the handle...
|
|
; now copy the file name into the handle...
|
|
lda tempNameBuf ; get the length of the string...
|
|
and #$00FF
|
|
tay
|
|
longa off
|
|
sep #$20
|
|
@CPLoop lda TempNameBuf,y
|
|
sta [TempPtr],y
|
|
dey
|
|
bpl @CPLoop
|
|
rep #$20
|
|
longa on
|
|
; now build the proper list entry...
|
|
lda <tempInt ; get the entry number
|
|
asl a ; multiply it by 20.. (list size...)
|
|
asl a ; by 4
|
|
pha
|
|
asl a
|
|
asl a ; by 16
|
|
clc
|
|
adc 1,s ; create *20
|
|
plx ; discard our temp..
|
|
tax ; and put the offset into <X>
|
|
|
|
lda <TempPtr
|
|
sta PathList+MemString,x
|
|
lda <TempPtr+2
|
|
sta PathList+MemString+2,x
|
|
; set the flags...
|
|
lda #$000F ; say its a folder for now...
|
|
sta PathList+MemType,x
|
|
lda #$8060
|
|
sta PathList+MemFlag,x
|
|
; and the entry is made! Now, determine if we need to get more stuff
|
|
lda PathLeft
|
|
beq @ListDone
|
|
lda <tempInt ; bump the list entry count
|
|
cmp #$000F ; we at 16 entries yet?
|
|
bge @ListTooBig
|
|
inc a
|
|
sta <TempInt
|
|
brl @NextName ; and do another entry
|
|
@ListDone
|
|
; Note at this point <X> still points to our list entry
|
|
lda #$0001
|
|
sta PathList+MemType,x
|
|
@ListTooBig
|
|
; Now its time to do the new list2 call on this here list...
|
|
; PathList:=getCtlHandleFromID(IdleWind,1015 + screenMode);
|
|
; ShowControl(PathList);
|
|
PushLong #MyMemberDraw
|
|
pea 1
|
|
PushLong #PathList
|
|
pea 0
|
|
lda <tempint
|
|
inc a
|
|
pha
|
|
;
|
|
pha
|
|
pha
|
|
PushLong >IdleWind
|
|
ldx #0
|
|
lda >screenMode
|
|
clc
|
|
adc #1015
|
|
bcc @1
|
|
inx
|
|
@1 phx
|
|
pha
|
|
_GetCtlHandleFromID
|
|
_NewList2
|
|
; now the list is made and can be displayed at will!
|
|
pla
|
|
pla
|
|
pla
|
|
plb
|
|
pld
|
|
longa off
|
|
sep #$20
|
|
pla
|
|
ply
|
|
plx
|
|
plx
|
|
phy
|
|
pha
|
|
longa On
|
|
Rep #$20
|
|
rtl
|
|
;
|
|
; This next routine strips a file name down to the colon and stores it in
|
|
; the temp buffer...
|
|
StripFileName
|
|
longa off
|
|
sep #$20
|
|
ldy PathLeft ; index into the string
|
|
ldx #0 ; index into tempnamebuf
|
|
@StripLoop1 lda [theInStr],y ; get the next value...
|
|
dey ; lower our string counter..
|
|
inx
|
|
cmp #':' ; if its a colon the pathname is over..
|
|
bne @StripLoop1
|
|
; ok, we now know the length of the string to move and
|
|
; now copy the string...
|
|
stx TempNameBuf ; save the string length first!
|
|
cpx #0
|
|
beq @SL2Done
|
|
ldy PathLeft
|
|
@StripLoop2 lda [theInStr],y
|
|
;;; sta TempNameBuf,x
|
|
*** 8-Dec-91 DAL
|
|
cpx #1
|
|
beq @skipColon
|
|
sta TempNameBuf-1,x
|
|
@skipColon
|
|
*** end 8-Dec-91 DAL
|
|
dey
|
|
dex
|
|
bne @StripLoop2
|
|
@SL2Done
|
|
; the string is done, now update the PathLeft Value...
|
|
sty PathLeft ; and save the value...
|
|
|
|
*** 8-Dec-91 DAL
|
|
dec TempNameBuf ;we skipped the leading colon
|
|
*** end 8-Dec-91
|
|
|
|
lda TempNameBuf ; get the length in <A>
|
|
rep #$20
|
|
longa On
|
|
and #$00FF
|
|
inc a ; account for the length byte
|
|
rts ; and return
|
|
|
|
PathLeft ds.W 1
|
|
PathList ds.B MemRecSize*16 ; allow 16 levels of directories...
|
|
SizeOfPathList equ *-PathList ; bytes in our local pathlist..
|
|
TempNameBuf ds.B 32 ; enough to hold a single pathname
|
|
endp
|
|
|
|
|
|
EJECT
|
|
*******************************************************************************
|
|
*
|
|
MyMemberDraw PROC Export
|
|
with PopupGlobals
|
|
*
|
|
* Description: Procedure used to draw members in my list. This procedure will
|
|
* take care of drawing each member in the list as well as drawing
|
|
* the proper small icon to the left of it.
|
|
*
|
|
*
|
|
*
|
|
; My member record for use with the passed member record
|
|
MemString equ 0
|
|
MemFlag equ MemString+4
|
|
MemFullName equ MemFlag+2
|
|
MemType equ MemFullName+4
|
|
MemAux equ MemType+2
|
|
MemEOF equ MemAux+4
|
|
* Inputs: None
|
|
*
|
|
* Outputs: None
|
|
*
|
|
* External Refs:
|
|
*
|
|
* Entry Points:
|
|
*
|
|
*******************************************************************************
|
|
; theStack
|
|
thedPage equ 1
|
|
theRTL equ thedPage+2
|
|
ListHndl equ theRTL+3
|
|
memPtr equ ListHndl+4
|
|
rectPtr equ memPtr+4
|
|
|
|
phd ; save the old dpage
|
|
tsc
|
|
tcd
|
|
|
|
pei <rectPtr+2
|
|
pei <rectPtr
|
|
_EraseRect ; erase the old rectangle...
|
|
|
|
ldy #2
|
|
lda [rectPtr],y ; get the Y coordinant
|
|
clc
|
|
adc #28
|
|
tax ; save for a bit
|
|
lda >screenMode ; 320 or 640 mode?
|
|
cmp #640
|
|
beq @its_640 ; 640, position is correct
|
|
txa ; get calculated position
|
|
sec
|
|
sbc #13 ; adjust for "narrower" icon in 320 mode
|
|
tax
|
|
@its_640
|
|
phx ; put horizontal position on stack
|
|
iny
|
|
iny
|
|
lda [rectPtr],y
|
|
dec a
|
|
pha
|
|
_MoveTo ; move to the proper spot
|
|
|
|
ldy #2
|
|
lda [memPtr],y
|
|
pha
|
|
lda [memPtr]
|
|
pha
|
|
_Drawstring
|
|
;
|
|
; Now that the member string has been drawn its time to draw the
|
|
; proper icon for this item...
|
|
;
|
|
|
|
*** 23-Apr-91 DAL -- use GetSysIcon instead of our local hard-coded icon tables
|
|
*** 22-May-91 MSD -- Use SearchDevNum for device number instead of the volume
|
|
*** selected in the volume pop-up. This fixes the bug where
|
|
*** the user changes the volume pop-up and that icon gets used
|
|
*** in the path display when you click on a found file.
|
|
|
|
pha
|
|
pha ;space for GetSysIcon result
|
|
|
|
ldy #memFlag
|
|
lda [memPtr],y
|
|
bpl @notDevice ; high bit = the bottom list; everything is device/folder
|
|
|
|
ldy #memType
|
|
lda [<memPtr],y
|
|
cmp #$000f
|
|
beq @notDevice
|
|
|
|
lda >SearchDevNum ; get volume actually searched (22-May-91 MSD)
|
|
sta >DevNum
|
|
_DInfoGS DInfoPBlock
|
|
lda >DeviceID
|
|
pea 1 ;flag for device icon
|
|
pha ;device ID
|
|
pea 0 ;moved here 5-Oct-92 DAL
|
|
pea 0 ;moved here from below (auxtype value)
|
|
bra @common
|
|
|
|
@notDevice ldy #memFlag ;use open folders for bottom list
|
|
lda [<memPtr],y
|
|
rol a
|
|
rol a
|
|
rol a
|
|
and #$0004
|
|
pha ;flag = 0 or 4
|
|
ldy #memType
|
|
lda [<memPtr],y
|
|
pha ;push file type
|
|
*** 5-Oct-92 DAL -- pass a real auxiliary type, not always zero
|
|
ldy #memAux+2
|
|
lda [<memPtr],y
|
|
pha
|
|
dey
|
|
dey
|
|
lda [<memPtr],y
|
|
pha
|
|
*** end 5-Oct-92
|
|
|
|
@common _GetSysIcon
|
|
|
|
*** end of 23-Apr-91 DAL (icon pointer now on stack)
|
|
|
|
pea 0 ; display mode
|
|
|
|
ldy #2 ; upper left corner of where icon is to go
|
|
lda [RectPtr],y
|
|
inc a
|
|
pha
|
|
lda [RectPtr]
|
|
inc a
|
|
pha
|
|
_DrawIcon
|
|
|
|
@IconDone
|
|
;
|
|
; At this point its time to dim or select the item...
|
|
ldy #MemFlag
|
|
lda [memPtr],y
|
|
and #$00C0 ; test to see if its selected
|
|
beq memDrawn
|
|
cmp #$0080
|
|
bne noSelect
|
|
|
|
pei <rectPtr+2
|
|
pei <rectPtr
|
|
_InvertRect
|
|
; bra memDrawn ;*** removed 26-Jan-93 SS
|
|
noSelect
|
|
; To support Item Dimming for non-selectable items, uncomment the following
|
|
; 6 lines of code. NOTE This has been left out because we don't want to dim in findfile...
|
|
; PushLong #DimMask
|
|
; _SetPenMask
|
|
; PushLong RectPtr
|
|
; _EraseRect
|
|
; PushLong #NorMask
|
|
; _SetPenMask
|
|
memDrawn
|
|
|
|
; clean up the stack
|
|
lda theRTL+1
|
|
sta theRTL+13 ; mopve the return address down 12
|
|
lda theRTL
|
|
sta theRTL+12
|
|
pld ; restore the original dpage
|
|
|
|
pla ; remove the passed parms
|
|
pla
|
|
pla
|
|
pla
|
|
pla
|
|
pla
|
|
rtl ; and just exit...
|
|
|
|
tempRect ds.W 4 ; used for drawing and masking...
|
|
|
|
EndP
|
|
|
|
EJECT
|
|
*******************************************************************************
|
|
*
|
|
ProcessLevel Proc Export
|
|
*
|
|
* Description: This routine will recursively step down directories
|
|
* adding items to our file list as it goes...
|
|
*
|
|
*
|
|
* Inputs: SpudFlag:Integer; Who called me...
|
|
*
|
|
* Outputs: None
|
|
*
|
|
* External Refs:
|
|
*
|
|
* Entry Points:
|
|
*
|
|
*******************************************************************************
|
|
;
|
|
; Stack for this call...
|
|
;
|
|
tempDeref equ 1
|
|
tempHandle equ tempDeref+4
|
|
MyRefNum equ tempHandle+4
|
|
MyPathLevel equ MyRefNum+2
|
|
i equ MyPathLevel+2
|
|
OldDPage equ i+2
|
|
theRTL equ OldDPage+2
|
|
passedFlag equ theRTL+2
|
|
FrameSize equ theRTL
|
|
;
|
|
; Nonframed equates
|
|
;
|
|
spudDPage equ 1
|
|
spudRTL equ 1
|
|
spudFlag equ spudRTL+3 ; so we can read the flag proper...
|
|
spudresult equ spudflag+2
|
|
|
|
; Always zero out tool error here!
|
|
lda #0
|
|
sta >AsmToolErr
|
|
|
|
; Now, before we start this function let's look at the spudflag and determine if we need to
|
|
; swap in our alternate stack...
|
|
lda spudFlag,s ; zero means called from pascal set up the stack stuff
|
|
bpl @notReentry
|
|
brl @ReEntry ; if negative means this is a reentry
|
|
@notReentry bne @Running ; if non-zero positive then we are currently running
|
|
lda >StackHandle+1 ; see if we are still running
|
|
bne @Running ; if this is non-zero then nope...
|
|
;
|
|
; If we are here then the DA is not yet started to search. This will now allocate a new
|
|
; stack for us to use...
|
|
ldx #0
|
|
pha ; room for result
|
|
pha
|
|
phx ; size of handle
|
|
pea $0800 ; in this case a 2k stack...
|
|
lda >MyID
|
|
ora #$0900 ; special stack memory
|
|
pha
|
|
pea $4005 ; fixed page align in abs bank
|
|
phx
|
|
phx ; X MUST BE ZERO!!!!
|
|
_NewHandle
|
|
tax ; save the error code for now!
|
|
pla
|
|
sta >StackHandle
|
|
pla
|
|
sta >StackHandle+2
|
|
bcc @gotStack
|
|
txa
|
|
sta >AsmToolErr ; save the tool error!
|
|
brl ProcessError1
|
|
@GotStack
|
|
; now deref the stack handle...
|
|
; get the pascal stack value
|
|
tsc ; get the current stack pointer
|
|
sta >PascalStack ; save the current stack level
|
|
tdc ;GACK! This was a TCD. 24-Sep-91 DAL
|
|
sta >PascalDPage ; also save the pascal dpage
|
|
|
|
phd
|
|
lda >StackHandle+2 ; we wanna deref this in fact...
|
|
pha ; we need to deref something...
|
|
lda >StackHandle
|
|
pha ; so give me some stack for a second...
|
|
tsc
|
|
tcd
|
|
lda [1] ; get our stack pointer
|
|
plx ; undo the temp direct page
|
|
plx
|
|
pld
|
|
clc
|
|
adc #$07F0 ; put us at the end!
|
|
sta >StackLevel ; save the new stack pointer into <X>
|
|
|
|
; we come here when we know that we already have a stack allocated
|
|
; this code will swap out the old stack and swap in the new stack if needed
|
|
tcs ; make it the new stack
|
|
lda #0 ; shortcut the next 2 lines
|
|
pha
|
|
; pea 0 ; and zero recursion stack its the end..
|
|
; lda #0 ; zero out the entry count
|
|
sta >EntryCount ; so we know when to exit properly
|
|
bra @EntryCont ; fininish the entry
|
|
brl Repeat ; now the proper stack is in place so continue
|
|
@running
|
|
; we come here when we know that we already have a stack allocated
|
|
; this code will swap out the old stack and swap in the new stack if needed
|
|
tsc ; get the current stack pointer
|
|
sta >PascalStack ; save the current stack level
|
|
tdc ;GACK! This was a TCD too! 24-Sep-91 DAL
|
|
sta >PascalDPage ; also save the pascal dpage
|
|
|
|
lda >StackLevel ; get the asynch stack pointer
|
|
tcs ; make it the new stack
|
|
pld ; get the proper direct page
|
|
pea 0 ; and zero recursion stack its the end..
|
|
lda #0 ; zero out the entry count
|
|
sta >EntryCount ; so we know when to exit properly
|
|
brl Repeat ; now the proper stack is in place so continue
|
|
@ReEntry
|
|
tsc ; get the current stack pointer
|
|
pha ; save it on the stack...
|
|
@EntryCont
|
|
; now enter the function proper
|
|
;
|
|
; Begin by setting up our stack frame......
|
|
phd
|
|
tsc
|
|
sec
|
|
sbc #FrameSize
|
|
tcd
|
|
tcs
|
|
|
|
;
|
|
; Now that our frame is set up, let's get to work...
|
|
; MyOpenRec.openPathname:=@currentDirPath;
|
|
|
|
lda #CurrentDirPath>>16
|
|
sta >MyOpenRec+4
|
|
lda #CurrentDirPath
|
|
sta >MyOpenRec+2
|
|
lda #0
|
|
sta >MyOpenRec
|
|
|
|
; OpenPD(MyOpenRec);
|
|
_OpenPD MyOpenRec
|
|
bcc @1
|
|
cmp #$45 ;VolNotFound?
|
|
bne @otherError
|
|
sta >Stopping
|
|
@otherError
|
|
sta >AsmToolErr
|
|
brl EndProcLevel
|
|
@1
|
|
|
|
; MyRefNum:=MyOpenRec.Openrefnum;
|
|
lda >MyOpenRec
|
|
sta <MyRefNum
|
|
|
|
; MyDirEntry.base:=1;
|
|
; MyDirEntry.Displacement:=1;
|
|
lda #1
|
|
sta >MyDirEntry+4
|
|
sta >MyDirEntry+6
|
|
|
|
; MyDirEntry.NameBuffer:=@tempNamePtr;
|
|
lda #TempNamePtr>>16
|
|
sta >MyDirEntry+$000A
|
|
lda #TempNamePtr
|
|
sta >MyDirEntry+$0008
|
|
|
|
; tempNamePtr.stat:=16;
|
|
lda #40
|
|
sta >TempNamePtr
|
|
|
|
Repeat
|
|
; For proper asynch operation, we must now test the entrycount first, if we
|
|
; have passed our threshold of entries then we need to back out for now...
|
|
lda >EntryCount ; get the current entry count
|
|
cmp #MaxPerLevel ; have we done the proper number yet?
|
|
blt @Repeatcont
|
|
brl AsynchExit ; else exit asynch level
|
|
@RepeatCont
|
|
; MyDirEntry.refnum:=MyRefNum;
|
|
lda <MyRefNum
|
|
sta >MyDirEntry
|
|
;
|
|
; Now we determine if we should stop now.
|
|
lda >Stopping
|
|
bne @BetterStop ; if the flag is non-zero then we must stop
|
|
; Get_Dir_Entry(MyDirEntry);
|
|
_Get_Dir_Entry MyDirEntry
|
|
bcc @2
|
|
cmp #$45 ; Volume Not Found?
|
|
bne @BetterStop ; no, exit normally
|
|
sta >Stopping ; else make sure we stop completely
|
|
@BetterSTop brl GDEError
|
|
|
|
; if AsmToolErr=0 then
|
|
; begin
|
|
; tempString[0]:=char(tempNamePtr.length); {Set the length of the string}
|
|
@2
|
|
;
|
|
; First bump the entry count to indicate we got a good one
|
|
lda >EntryCount
|
|
inc a
|
|
sta >EntryCount
|
|
|
|
lda >TempNamePtr+2
|
|
sep #$20
|
|
Longa Off
|
|
sta >tempString
|
|
rep #$20
|
|
Longa On
|
|
|
|
; for i:=1 to 32 do
|
|
; tempString[i]:=tempNamePtr.theName[i];
|
|
ldx #0
|
|
@CopyLoop1
|
|
lda >tempNamePtr+4,x
|
|
sta >tempString+1,x
|
|
inx
|
|
inx
|
|
cpx #32 ; see if we are finished...
|
|
blt @CopyLoop1
|
|
|
|
|
|
; AddFile(tempString); {Add the filename to the list...}
|
|
PushLong #tempString
|
|
jsl AsmAddFile
|
|
pla
|
|
pla
|
|
|
|
; if MyDirEntry.fileType = $000F then {Check for recursion...}
|
|
; begin
|
|
lda >MyDirEntry+$000E
|
|
cmp #$000F
|
|
beq @3
|
|
brl NotADirectory
|
|
|
|
; MyPathLevel:=ord(CurrentDirPath[0]); {Save the old pathname}
|
|
@3 lda >CurrentDirPath
|
|
and #$00FF
|
|
sta <MyPathLevel
|
|
|
|
|
|
; if MyPathLevel+tempNamePtr.length<255 then
|
|
clc
|
|
adc >tempNamePtr+2
|
|
cmp #$0100
|
|
blt @4
|
|
brl fNameTooLong
|
|
|
|
;
|
|
; begin
|
|
; currentDirPath:=Concat(currentDirPath,tempString,':');
|
|
@4
|
|
lda #currentDirPath>>16 ; create a pointer to our dest string
|
|
sta <tempDeref+2
|
|
lda #currentDirPath
|
|
sta <tempDeref
|
|
lda >currentDirPath ; add its current length...
|
|
and #$00FF
|
|
sec ;always add 1 extra
|
|
adc <tempderef
|
|
sta <tempDeref
|
|
bcc @5
|
|
inc <tempDeref+2
|
|
@5
|
|
lda >tempNamePtr+2 ; get the length to copy
|
|
sta <i ; save it on direct page
|
|
|
|
ldx #0 ; now do our copy...
|
|
@concatLoop lda >tempNamePtr+4,x ; source word
|
|
txy
|
|
sta [<tempderef],y ; save it in our destination
|
|
inx
|
|
inx
|
|
cpx <i ; are we done?
|
|
blt @concatLoop ; nope, keep going...
|
|
; we are now done copying the string, now fix the length and add the : at the end
|
|
|
|
lda >currentDirPath
|
|
clc
|
|
adc <i
|
|
inc a ; add 1 for the ":"
|
|
sta >currentDirPath
|
|
and #$00FF ; just get the length
|
|
tax ; use as an index
|
|
lda #':' ; load the terminator char
|
|
sta >currentDirPath,x ; and finish the name
|
|
|
|
; ProcessLevel;
|
|
pha ; room for result
|
|
pea $FFFF ; flag says we are reentering
|
|
jsl ProcessLevel ; do the next level...
|
|
pla
|
|
; AsmToolErr:=0;
|
|
|
|
; CurrentDirPath[0]:=chr(MyPathLevel); {Back the sucker off now...}
|
|
lda <MyPathLevel
|
|
sep #$20
|
|
longa Off
|
|
sta >CurrentDirPath
|
|
rep #$20
|
|
LongA On
|
|
|
|
; end;
|
|
; end;
|
|
; end;
|
|
fNameTooLong
|
|
NotADirectory
|
|
brl Repeat
|
|
;
|
|
; Interupt ready...
|
|
AsynchExit
|
|
phd ; save the current direct page also!
|
|
tsc ; get the current stack level
|
|
sta >StackLevel ; and save it in our global
|
|
lda >PascalStack ; get the DA stack level back
|
|
tcs ; and make it the current stack
|
|
lda >PascalDPage
|
|
tcd
|
|
lda #1 ; get the proper level flag
|
|
sta spudResult,s ; and make it the result for now...
|
|
lda spudRTL+1,s ; move the RTL down
|
|
sta spudRTL+3,s ; down 2 bytes
|
|
lda spudRTL,s
|
|
sta spudRTL+2,s
|
|
pla ; recover the crap
|
|
RTL ; and finally return
|
|
GDEError
|
|
; until AsmToolErr<>0;
|
|
; debug;
|
|
|
|
; MyClose.fileRefNum:=MyRefNum;
|
|
; ClosePD(MyClose);
|
|
lda <MyRefNum
|
|
sta >MyClose
|
|
_ClosePD MyClose
|
|
|
|
; end; {procedure}
|
|
EndProcLevel
|
|
ProcessError1
|
|
tdc ; unlink our local frame
|
|
clc
|
|
adc #FrameSize
|
|
tcs ; make it our current stack
|
|
pld ; recover the orihginal dpage
|
|
;
|
|
; Now we need to unlink the rest of the alternate stack crap
|
|
; and also see where we were called from...
|
|
pla ; recover the old stack level
|
|
bne @proce1 ; if this is non-zero then we are recursed
|
|
lda >PascalDPage ; recover the direct page
|
|
tcd
|
|
lda >PascalStack ; if zero, get the pascal stack level
|
|
@ProcE1
|
|
tcs ; make it the current stack pointer
|
|
lda spudFlag,s ; get the spudflag
|
|
sta spudResult,s ; and make it the result for now...
|
|
lda spudRTL+1,s ; move the RTL down
|
|
sta spudRTL+3,s ; down 2 bytes
|
|
lda spudRTL,s
|
|
sta spudRTL+2,s
|
|
pla ; recover the crap
|
|
RTL ; and finally return
|
|
|
|
PascalDPage ds.W 1 ; place to save the pascal direct page
|
|
EndP
|
|
|
|
;
|
|
; The following will do the proper comparison and then add the item to the list if
|
|
; it matches the proper criterion
|
|
;
|
|
AsmAddFile Proc Export
|
|
with PopupGlobals
|
|
import InvisibleFlag
|
|
|
|
; Stack for this call...
|
|
tempDeref equ 1
|
|
tempHandle equ tempDeref+4
|
|
InputString equ tempHandle+4
|
|
i equ InputString+4
|
|
OldDPage equ i+2
|
|
theRTL equ OldDPage+2
|
|
theName equ theRTL+3
|
|
|
|
FrameSize equ theRTL
|
|
;
|
|
;DirEntryRec = RECORD
|
|
;
|
|
DERrefNum equ 0 ; integer
|
|
DERreserved equ DERRefNum+2 ; integer
|
|
DERbase equ DERreserved+2 ; Integer;
|
|
DERdisplacement equ DERbase+2 ; Integer;
|
|
DERnameBuffer equ DERdisplacement+2 ; Ptr;
|
|
DERentryNum equ DERnameBuffer+4 ; Integer;
|
|
DERfileType equ DERentryNum+2 ; Integer;
|
|
DERendOfFile equ DERfileType+2 ; Longint;
|
|
DERblockCount equ DERendOfFile+4 ; Longint;
|
|
DERcreateTime equ DERblockCount+4 ; TimeRec;
|
|
DERmodTime equ DERcreateTime+8 ; TimeRec;
|
|
DERaccess equ DERmodTime+8 ; Integer;
|
|
DERauxType equ DERaccess+2 ; Longint;
|
|
DERfileSysID equ DERauxType+4 ; Integer;
|
|
|
|
;
|
|
; Begin by setting up our stack frame......
|
|
;
|
|
lda 4,s
|
|
tax
|
|
lda 6,s
|
|
tay ; recover our parameter
|
|
|
|
phd
|
|
tsc
|
|
sec
|
|
sbc #FrameSize
|
|
tcd
|
|
tcs
|
|
|
|
stx <InputString
|
|
sty <InputString+2
|
|
|
|
*** added 1-Oct-91 DAL -- only find invisible files if we want them
|
|
lda >MyDirEntry+DERaccess
|
|
and #$0004 ;invisible bit
|
|
beq @notInvisible
|
|
lda >InvisibleFlag
|
|
and #$00ff
|
|
bne @findItAnyway
|
|
brl EndProcLevel
|
|
@findItAnyway
|
|
@notInvisible
|
|
*** end 1-Oct-91
|
|
|
|
; Now do the proper match
|
|
jsr MatchIt
|
|
bcc @addIt
|
|
brl EndProcLevel
|
|
@addit
|
|
lda >MyListCnt ; see if we have too many items
|
|
cmp #MaxEntries ; see if we are beyond the threshold
|
|
blt @Addit010 ; if not, then continue
|
|
lda #$FFFF ; flag list overrun
|
|
sta >Stopping ; and save it in our flag to say stop
|
|
brl EndProcLevel
|
|
@Addit010
|
|
; tempHandle:=Str255Hndl(NewHandle(16,MyID+$0700,attrFixed,NIL));
|
|
pha ; room for result
|
|
pha
|
|
pea 0 ; size
|
|
pea 40 ; 32 bytes
|
|
lda >MyID
|
|
ora #$0700
|
|
pha
|
|
pea $4000
|
|
pha
|
|
pha
|
|
_NewHandle
|
|
pla
|
|
plx
|
|
sta <tempHandle
|
|
stx <tempHandle+2
|
|
|
|
; PtrToHand(@theFile,Handle(tempHandle),16); {copy the file name...}
|
|
pei <InputString+2
|
|
pei <InputString
|
|
pei <tempHandle+2
|
|
pei <tempHandle
|
|
PushLong #40
|
|
_PtrToHand
|
|
|
|
; MyList^^[myListCnt].memString:=Ptr(tempHandle^); {save the string pointer}
|
|
lda >MyList ; deref MyList
|
|
sta <tempDeref
|
|
lda >MyList+2
|
|
sta <tempDeref+2
|
|
ldy #2
|
|
lda [<tempDeref],y
|
|
tax
|
|
lda [<tempDeref]
|
|
sta <tempDeref
|
|
stx <tempDeref+2
|
|
; now create a pointer to the proper record in the list...
|
|
; each list entry is 20
|
|
lda >MyListCnt ; create MyListCnt*10
|
|
asl a
|
|
pha
|
|
asl a
|
|
asl a
|
|
clc
|
|
adc 1,s
|
|
plx
|
|
asl a ; multiply by 2 to get *20
|
|
clc
|
|
adc <tempDeref ; add the low byte first
|
|
tax ; and save it...
|
|
ldy #2 ; now the high byte
|
|
lda <tempDeref+2
|
|
bcc @2
|
|
inc a
|
|
@2 sta <tempDeref+2
|
|
stx <tempDeref
|
|
;
|
|
; Lucky for us all the proper file info is in the current dir entry record
|
|
; still. So suck some more info out of the dir entry and put them into my record
|
|
; here...
|
|
;
|
|
memFlag equ 4
|
|
memFullName equ 6
|
|
memFileType equ 10
|
|
memAuxType equ 12
|
|
memEOF equ 16
|
|
;
|
|
; we now have a pointer to the list element let's stuff it
|
|
; First the string pointer
|
|
ldy #2
|
|
lda [<tempHandle],y
|
|
sta [<tempDeref],y
|
|
lda [<tempHandle]
|
|
sta [<tempDeref]
|
|
|
|
; MyList^^[myListCnt].memFlag:=0; {set to member type}
|
|
lda #0
|
|
ldy #4
|
|
sta [<tempDeref],y
|
|
;
|
|
; And now, update the rest of the files data to reflect the dir entry data
|
|
lda >MyDirEntry+DERAuxType
|
|
ldy #memAuxType
|
|
sta [tempDeref],y
|
|
lda >MyDirEntry+DERAuxType+2
|
|
ldy #memAuxType+2
|
|
sta [tempDeref],y
|
|
lda >MyDirEntry+DERfileType
|
|
ldy #memfileType
|
|
sta [tempDeref],y
|
|
lda >MyDirEntry+DERendOfFile
|
|
ldy #memEOF
|
|
sta [tempDeref],y
|
|
lda >MyDirEntry+DERendOfFile+2
|
|
ldy #memEOF+2
|
|
sta [tempDeref],y
|
|
;
|
|
; Now that the record is updated, update the list
|
|
; tempHandle:=Str255Hndl(NewHandle(ord(theFile[0])+ord(CurrentDirPath[0])+3,MyID+$0700,0,NIL));
|
|
|
|
lda [<InputString]
|
|
clc
|
|
adc >CurrentDirPath
|
|
and #$00FF
|
|
adc #3
|
|
|
|
pha
|
|
pha
|
|
|
|
pea 0
|
|
pha
|
|
lda >MyID
|
|
ora #$0700
|
|
pha
|
|
pea 0
|
|
pha
|
|
pha
|
|
_NewHandle
|
|
; MyList^^[myListCnt].MemFullName:=newHandle;
|
|
ldy #6
|
|
pla
|
|
sta [<tempDeref],y
|
|
sta <tempHandle
|
|
iny
|
|
iny
|
|
pla
|
|
sta [<tempDeref],y
|
|
sta <tempHandle+2
|
|
|
|
; tempHandle^^:=Concat(currentDirPath,tempString);
|
|
ldy #2
|
|
lda [<tempHandle],y
|
|
sta <tempderef+2
|
|
lda [<tempHandle]
|
|
sta <tempDeref
|
|
; First, copy current path over
|
|
lda >currentDirPath
|
|
and #$00FF
|
|
sta <i ; set the length to copy
|
|
|
|
ldy #1
|
|
ldx #1
|
|
; and start the copy
|
|
@copyCur lda >currentDirPath,x
|
|
sta [<tempderef],y
|
|
iny
|
|
inx
|
|
cpx <i
|
|
blt @copyCur
|
|
|
|
; now copy input string to the end...
|
|
lda <i
|
|
clc
|
|
adc <tempDeref
|
|
sta <tempderef
|
|
bcc @10
|
|
inc <tempDEREF+2
|
|
@10
|
|
; compute new size to copy
|
|
lda [<inputString]
|
|
and #$00FF
|
|
sta <i
|
|
ldy #1
|
|
;
|
|
@Loop
|
|
lda [<inputString],y
|
|
sta [<tempDeref],y
|
|
iny
|
|
cpy <i
|
|
blt @Loop
|
|
;
|
|
; Now compute the new string length...
|
|
lda >currentDirPath
|
|
and #$00FF
|
|
clc
|
|
adc <i
|
|
and #$00FF
|
|
sta <i
|
|
|
|
ldy #2
|
|
lda [<tempHandle],y
|
|
sta <tempderef+2
|
|
lda [<tempHandle]
|
|
sta <tempDeref
|
|
lda [<tempDeref]
|
|
and #$FF00
|
|
ora <i
|
|
sta [<tempDeref]
|
|
|
|
lda >MyListCnt
|
|
inc a
|
|
sta >MyListCnt
|
|
|
|
; NewList2(MyMemberDraw,-1,ref(MyList),1,myListCnt,listCtrl);
|
|
|
|
PushLong #MyMemberDraw
|
|
pea $FFFF
|
|
PushLong MyList
|
|
pea 1
|
|
lda >MyListCnt
|
|
pha
|
|
PushLong ListCtrl
|
|
_NewList2
|
|
EndProcLevel
|
|
tdc ; unlink our local frame
|
|
clc
|
|
adc #FrameSize
|
|
tcs ; make it our current stack
|
|
pld ; recover the orihginal dpage
|
|
RTL
|
|
|
|
MatchIt
|
|
; Routine to compare and match the file names
|
|
; This routine requires that the MatchStr be lower cased.
|
|
; it trashed the contents of tempHandle and i
|
|
;
|
|
matchTemp equ tempHandle
|
|
stz <i
|
|
lda >MatchType
|
|
dec a
|
|
asl a
|
|
tax
|
|
jsr (matchTbl,x)
|
|
rts
|
|
matchTbl dc.W Exact
|
|
dc.W StartsWith
|
|
dc.W EndsWith
|
|
dc.W Contains
|
|
dc.W WildCard ; finds with certain wild card characters
|
|
;
|
|
Exact
|
|
; Test to see if the filename is an exact match of the matchstr
|
|
sep #$20
|
|
Longa Off
|
|
lda >MatchStr ; get the length of the match string
|
|
sta <i
|
|
cmp [<InputString]
|
|
beq @Cont
|
|
brl MatchFail
|
|
@cont
|
|
ldy #1
|
|
@CompLoop tyx ; make both indexs the same
|
|
lda [<InputString],y
|
|
cmp #'A' ; first see if its upper case
|
|
blt @NonAlpha ; if less than its a non-alpha compare
|
|
ora #$20 ; make it lower case always...
|
|
sta <matchTemp ; save it for a second
|
|
lda >MatchStr,x ; get the char to match
|
|
ora #$20 ; make sure its lower case
|
|
cmp <matchTemp ; see if they are the same
|
|
beq @NextChar
|
|
brl MatchFail
|
|
|
|
@NonAlpha cmp >MatchStr,x
|
|
beq @NextChar
|
|
brl MatchFail
|
|
|
|
@NextChar
|
|
iny
|
|
cpy <i ; test if we are done...
|
|
blt @compLoop
|
|
beq @compLoop
|
|
REP #$20
|
|
Longa On
|
|
clc
|
|
rts
|
|
|
|
StartsWith
|
|
; Test to see if the filename is an exact match of the matchstr
|
|
sep #$20
|
|
Longa Off
|
|
lda >MatchStr ; get the length of the match string
|
|
sta <i
|
|
cmp [<InputString]
|
|
blt @Cont
|
|
beq @Cont
|
|
brl MatchFail
|
|
@cont
|
|
ldy #1
|
|
@CompLoop tyx ; make both indexs the same
|
|
lda [<InputString],y
|
|
cmp #'A' ; first see if its upper case
|
|
blt @NonAlpha ; if less than its a non-alpha compare
|
|
ora #$20 ; make it lower case always...
|
|
sta <matchTemp ; save it for a second
|
|
lda >MatchStr,x ; get the char to match
|
|
ora #$20 ; make sure its lower case
|
|
cmp <matchTemp ; see if they are the same
|
|
beq @NextChar
|
|
brl MatchFail
|
|
|
|
@NonAlpha cmp >MatchStr,x
|
|
beq @NextChar
|
|
brl MatchFail
|
|
|
|
@NextChar
|
|
iny
|
|
cpy <i ; test if we are done...
|
|
blt @compLoop
|
|
beq @compLoop
|
|
REP #$20
|
|
Longa On
|
|
clc
|
|
rts
|
|
|
|
EndsWith
|
|
; Test to see if the filename is an exact match of the matchstr
|
|
sep #$20
|
|
Longa Off
|
|
lda >MatchStr ; get the length of the match string
|
|
sta <i
|
|
cmp [<InputString]
|
|
blt @Cont
|
|
beq @Cont
|
|
brl MatchFail
|
|
@cont ; now set up the counters for matching
|
|
lda [<inputString] ; get the length of the source str
|
|
tay ; place it in <X>
|
|
lda <i ; now get the length of the match string
|
|
tax
|
|
|
|
@CompLoop
|
|
lda >MatchStr,x ; get the last char of match string
|
|
cmp #'A' ; first see if its upper case
|
|
blt @NonAlpha ; if less than its a non-alpha compare
|
|
ora #$20 ; make it lower case always...
|
|
sta <matchTemp ; save it for a second
|
|
lda [<inputString],y ; get the char to match
|
|
ora #$20 ; make sure its lower case
|
|
cmp <matchTemp ; see if they are the same
|
|
beq @NextChar
|
|
brl MatchFail
|
|
|
|
@NonAlpha cmp [<InputString],y
|
|
beq @NextChar
|
|
brl MatchFail
|
|
|
|
@NextChar
|
|
dey ; decrement input counter
|
|
dex ; and match counter
|
|
bne @CompLoop ; if MatchCounter >0 then keep going
|
|
REP #$20
|
|
Longa On
|
|
clc ; else we are done and we found a match
|
|
rts
|
|
|
|
;
|
|
Contains
|
|
; Now see if input contains matchString
|
|
; First be sure that the Matchstr can be contained by testing the length
|
|
; NOTE: This routine requires that the matchstr be lowercased first.
|
|
;
|
|
; This routine trashes i and matchtemp
|
|
;
|
|
stz i
|
|
stz MatchTemp
|
|
stz MatchTemp+2
|
|
sep #$20
|
|
Longa Off
|
|
lda >MatchStr ; get the length of the match string
|
|
sta <i ; into i (our counter)
|
|
cmp [<InputString]
|
|
blt @Cont
|
|
beq @Cont
|
|
brl MatchFail
|
|
;
|
|
; at this point we know that it is physically possible for matchstr to fit inside
|
|
; the inputstring. Now, start testing for the match...
|
|
; MatchTemp will contain our current pointer... matchTemp+2 the size of Inputstr
|
|
;
|
|
@cont
|
|
rep #$20
|
|
longa On
|
|
lda [<InputString]
|
|
and #$00FF
|
|
sta <MatchTemp+2
|
|
ldy #0 ; init our string pointer
|
|
@FindFirst cpy <MatchTemp+2 ; see if we are done
|
|
bge @NotHere ; if so, it must not be here!
|
|
iny
|
|
lda [<InputString],y
|
|
and #$00FF ; strip the byte...
|
|
cmp #'A' ; lowercase it...
|
|
blt @FF0010
|
|
cmp #'Z'+1
|
|
bge @FF0010
|
|
ora #$0020
|
|
@FF0010 sta <MatchTemp
|
|
lda >MatchStr+1
|
|
and #$00FF
|
|
cmp <MatchTemp ; see if these are the same...
|
|
bne @FindFirst ; they are not, so continue till done
|
|
|
|
;
|
|
; If we get here then we have found the first char of matchstr in inputstr
|
|
; let's continue on...
|
|
;
|
|
; Save current value for Y first
|
|
sty <MatchTemp
|
|
|
|
; see if whats left of the input string can contain match string
|
|
lda <MatchTemp+2 ; length of inputstr
|
|
sec
|
|
sbc <MatchTemp ; see if its too long...
|
|
;
|
|
; 2/12/90 Mensch
|
|
; Fix bug here since Y was already incremented (Its based on 1 not 0) the following
|
|
; arithmetic will not work right. what we really have to do now is decrement it...
|
|
;
|
|
inc a ; adjust for a too big Y
|
|
cmp <i
|
|
bge @maybehere ; if its >= than i then it cound be here!
|
|
@NotHere
|
|
; otherwise, it can't be in this string... better button up and leave
|
|
rep #$20
|
|
longa on
|
|
sec ; signal failure
|
|
rts ; and go back...
|
|
|
|
@MaybeHere
|
|
; This routine will determine if the string is actually inside of the input
|
|
; string...
|
|
ldy <MatchTemp ; start at the beginning
|
|
phy ; save the length...
|
|
ldx #0 ; with both strings...
|
|
@FindRest cpx <i ; is x equal to the ending condition?
|
|
beq @GotIt ; if so, then I got one!
|
|
inx
|
|
lda [<InputString],y
|
|
and #$00FF ; strip the byte...
|
|
cmp #'A' ; lowercase it...
|
|
blt @FR0010
|
|
cmp #'Z'+1
|
|
bge @FR0010
|
|
ora #$0020
|
|
@FR0010 sta <MatchTemp
|
|
lda >MatchStr,x
|
|
and #$00FF
|
|
cmp <MatchTemp ; see if these are the same...
|
|
bne @tryAgain ; they are not, so back to main loop
|
|
iny
|
|
bra @FindRest
|
|
@TryAgain ply ; if we get here the string wasn't found yet
|
|
brl @FindFirst
|
|
;
|
|
; This is called when we have found the whole string ...
|
|
@GotIt
|
|
ply ; recover its location...
|
|
rep #$20
|
|
longa on
|
|
clc ; signal success
|
|
rts ; and go back...
|
|
|
|
MatchFail rep #$20
|
|
longa on
|
|
sec ; signal failure
|
|
rts ; and go back...
|
|
|
|
|
|
************************************************************
|
|
*
|
|
* WildCard
|
|
*
|
|
* This routine searches InputString for MatchStr and returns with
|
|
* the carry clear if found, set if not found...
|
|
*
|
|
* The current wild card operation is the same as Equal except that
|
|
* it also supports the following Wildcard characters:
|
|
*
|
|
* §- Match any ASCII letter (Upper or lower case)
|
|
* £- Match any numeric digit
|
|
* Å- Match any stream of data (Only one of these per find item)
|
|
*
|
|
************************************************************
|
|
WildCard
|
|
; Test to see if the filename is an exact match of the matchstr
|
|
stz i
|
|
stz MatchTemp+2
|
|
sep #$20
|
|
Longa Off
|
|
lda >MatchStr ; get the length of the match string
|
|
sta MatchTemp+2 ; save it in our special place
|
|
lda [<InputString] ; now do the input string length
|
|
sta <i
|
|
; Note no length checking here because of wild card construction...
|
|
@cont
|
|
ldy #1
|
|
ldx #1
|
|
@CompLoop ; make both indexs the same
|
|
lda >MatchStr,x ; get the next char to match
|
|
cmp #'£' ; is it match number?
|
|
beq @CompNum
|
|
cmp #'§' ; is it match Letter?
|
|
beq @CompAlpha
|
|
cmp #'Å' ; is it stream of data?
|
|
beq @CompHole
|
|
; Else just a normal compare will do...
|
|
lda [<InputString],y
|
|
cmp #'A' ; first see if its upper case
|
|
blt @CompNorm01 ; if less than its a non-alpha compare
|
|
cmp #'Z'+1 ; is it greater?
|
|
bge @CompNorm01
|
|
ora #$20 ; make it lower case always...
|
|
@CompNorm01 cmp >MatchStr,x ; get the char to match
|
|
beq @NextChar
|
|
brl @MatchFail
|
|
;
|
|
; Only test its numericness....
|
|
@CompNum lda [<InputString],y
|
|
cmp #'0'
|
|
blt @MatchFail
|
|
cmp #'9'+1
|
|
bge @MatchFail
|
|
bra @NextChar
|
|
|
|
;
|
|
; Test its alphaness...
|
|
@CompAlpha lda [<InputString],y
|
|
cmp #'A'
|
|
blt @MatchFail
|
|
cmp #'Z'+1
|
|
blt @NextChar
|
|
cmp #'a'
|
|
blt @MatchFail
|
|
cmp #'z'+1
|
|
blt @NextChar
|
|
@MatchFail brl MatchFail
|
|
;
|
|
; The match passes so far..
|
|
@NextChar
|
|
iny
|
|
inx
|
|
cpx <MatchTemp+2 ; see if we are finished..
|
|
blt @ContHC
|
|
beq @ContHC
|
|
bra @MatchGood ; else if size does not pan out then its a fail..
|
|
@ContHC cpy <i ; test if we are done...
|
|
blt @compLoop
|
|
beq @compLoop
|
|
@MatchGood REP #$20
|
|
Longa On
|
|
clc
|
|
rts
|
|
|
|
;
|
|
; This next routine will work with holes. If a whole has been found then it
|
|
; will finish finding the rest of the string starting at the back...
|
|
; NOTE:<X> contains the offset into the matchstr
|
|
; <Y> comtains the offset into the inputstring
|
|
;
|
|
@CompHole
|
|
; First see if wild card is at the end of the match string. If so then
|
|
; we have found a match!
|
|
;
|
|
cpy <MatchTemp+2
|
|
bge @MatchGood
|
|
;
|
|
; Otherwise we have a certain number of characters left in the string to find...
|
|
; we must calculate how many...
|
|
stx <MatchTemp ; save the current offset into matchstr
|
|
lda <MatchTemp+2 ; get the length of match string
|
|
sec
|
|
sbc <MatchTemp ; subtract where we are...
|
|
sta <MatchTemp ; matchTemp now cleverly contains
|
|
lda <i ; number of chars in inputstr
|
|
sec
|
|
sbc <MatchTemp
|
|
sta <MatchTemp ; save it in match temp
|
|
cpy <MatchTemp ; see if this is legal...
|
|
blt @MatchFail ; if <Y> is less than then not enough chars
|
|
ldy <MatchTemp ; restart the comparison at this point with the new offset
|
|
brl @NextChar ; and get the next character
|
|
|
|
EndP
|
|
|
|
End
|