*****************************************************************
*
* File Module Two, the sequel 1990
*
* Copyright 1989, 1990
* Simple Software Systems International, Inc.
*
* ALL RIGHTS RESERVED
*
* Marc Wolfgram, (30Mar89) 13Feb90
*
*****************************************************************
*
           case     on

           copy     2/ainclude/e16.types
           copy     2/ainclude/e16.dialog
           copy     2/ainclude/e16.control
           copy     2/ainclude/e16.event
           copy     2/ainclude/e16.memory
           copy     2/ainclude/e16.intmath
           copy     2/ainclude/e16.window

           copy     e16.genesys

           mcopy    file2.mac

******************************************************************************
NewRez     START
           using    Shell

           phb
           phd
           phk
           plb

           PushLong #UntitledP
           PushLong #UntitledN
           jsl      SetNames

           jsl      NullWork
           bcs      newExit
           bra      newOpen

NewApp     ENTRY

           phb
           phd
           phk
           plb

           PushLong #UntitledP
           PushLong #UntitledN
           jsl      SetNames

           jsl      NullWork
           bcs      newExit

           _WaitCursor
           PushLong #DefFile
           PushLong #Scratch
           jsl      CopyWork
           cmp      #0
           bne      newExit

newOpen    jsl      OpenWork
           pha
           lda      #-1
           sta      ChangedFlag
           sta      NewFileFlag
           pla

newExit    pha
           _InitCursor
           pla
           pld
           plb
           rtl

UntitledP  dc       i2'10',c'8:Untitled'
UntitledN  dc       i2'8',c'Untitled'

******************************************************************************
OpenRez    ENTRY

           phb
           phd
           phk
           plb

           PushLong #0
           _GetPort
           PushWord #120                Ask user for file to open
           PushWord #30
           PushWord #0                  IsPointer
           PushLong #OpenPrompt
           PushLong #ForkProc           Filter proc
           PushLong #0
           PushLong #NewReply
           _SFGetFile2
           ldx      #$4002
           jsl      shError2
           _SetPort

           lda      NewReply
           beq      openExit

           _WaitCursor
           PushLong #I1PName
           PushLong #I1UName
           jsl      SetNames
           jsl      NullWork
           bcs      openExit

           PushLong #FilePath
           PushLong #Scratch
           jsl      CopyWork
           cmp      #0
           bne      openError

openAgain  jsl      OpenWork

openExit   pha
           _InitCursor
           pla
           pld
           plb
           rtl

openError  cmp      #$4c                EOF
           bne      openExit

           PushWord #0                  Result
           PushWord #4                  C str resource
           PushLong #0                  Substitution string
           PushLong #6
           _AlertWindow
           pla
           beq      openNew
           lda      #0
           bra      openExit

openNew    PushLong #1                  auxtype
           PushWord #$5e                filetype
           PushWord #$c3
           PushLong #FilePath
           _CreateResourceFile          Now rebuild same
           bcs      openExit
           jsl      NullWork
           bcs      openExit
           bra      openAgain

******************************************************************************
SaveRez    ENTRY                        y = 0 on save, -1 on no save

           phb
           phd
           phk
           plb

           lda      NewFileFlag
           bne      saveAsNew
           brl      saveCommon

SaveAsRez  ENTRY

           phb
           phd
           phk
           plb

saveAsNew  PushLong #0
           _GetPort
           PushWord #160                Ask user where he wants New
           PushWord #30
           PushWord #0                  Next param is Pointer
           PushLong #NewPrompt
           PushWord #0                  Next param is Pointer
           PushLong #FileName
           PushLong #NewReply
           _SFPutFile2
           ldx      #$4202
           jsl      shError2
           _SetPort
           lda      NewReply
           bne      saveSetup
           ldy      #-1
           brl      saveAsExit

saveSetup  PushLong #I1PName
           PushLong #I1UName
           jsl      SetNames
           PushLong #RootNameStr        Set window title to new filename
           PushLong RootWPtr
           _SetWTitle

           PushLong #1                  auxtype
           PushWord #$5e                filetype
           PushWord #$c3
           PushLong #FilePath
           _CreateResourceFile          Now rebuild same
           beq      saveCommon
           cmp      #$1e01              Used is fine by me, bunkie...
           beq      saveCommon
           ldx      #$4210              ...anything else isn't, though :(
           jsl      shError2

saveCommon jsl doUpdate

           _WaitCursor

           PushLong #0
           _GetPort                     Left on the stack...
           PushLong #SavingTemp
           jsl      IODialog
           sta      DlogPtr
           stx      DlogPtr+2

           PushWord ResFileID
           _CloseResourceFile
           ldx      #$4214
           jsl      shError2
           PushLong #Scratch            from
           PushLong #FilePath           to
           jsl      CopyWork
           jsl      ErrMsg
           PushWord #0                  Result space
           PushWord #$03                Access???
           PushLong #0                  Map address
           PushLong #Scratch            Need I say it?
           _OpenResourceFile
           ldx      #$4216
           jsl      shError2
           PullWord ResFileID
           PushWord #-1
           PushWord GenFileID
           jsl      SetResAccess

           PushLong DlogPtr
           _CloseDialog
           _InitCursor
           _SetPort

           stz      ChangedFlag
           stz      NewFileFlag

           ldy      #0

saveAsExit lda      #0
           pld
           plb
           rtl

******************************************************************************
RevertRez  ENTRY
           using    Shell

           phb
           phd
           phk
           plb

           PushWord #0                  Result
           PushWord #4                  C str resource
           PushLong #0                  Substitution string
           PushLong #4
           _AlertWindow
           pla
           beq     dorevert

           lda      #0
           pld
           plb
           rtl

dorevert   jsl      CloseEds            done now so the dialog isn't deformed.

           PushLong #0
           _GetPort                     Left on the stack...
           PushLong #RevertTemp
           jsl      IODialog
           sta      DlogPtr
           stx      DlogPtr+2

           PushWord ResFileID
           _CloseResourceFile
           ldx      #$4302
           jsl      shError2
           PushLong #FilePath
           PushLong #Scratch
           jsl      CopyWork
           jsl      ErrMsg
           PushWord #0                  Result space
           PushWord #$03                Access???
           PushLong #0                  Map address
           PushLong #Scratch            Need I say it?
           _OpenResourceFile
           ldx      #$4304
           jsl      shError2
           PullWord ResFileID
           PushWord #-1
           PushWord GenFileID
           jsl      SetResAccess

           jsl      ReOpenWork

           PushLong DlogPtr
           _CloseDialog
           _InitCursor
           _SetPort

           stz      ChangedFlag

           lda      #0
           pld
           plb
           rtl

           END
******************************************************************************
SetNames   START
           using    Shell

           phb
           phd
           phk
           plb
           tsc                                      11111
           pha                          DP>12345678901234
           pld                          SP>dpbRTLnamepath

           lda      [11]
           tay
pathloop   lda      [11],y
           tyx
           sta      >FilePath,x
           dey
           beq      pathloop
           dey
           bpl      pathloop

           lda      [7]                 length word
           pha
           tay
           clc
           sta      FileName
           sta      SrcFName
           sta      EquFName
           sta      FileNameStr
           adc      #$2002              +2 and SPACE
           sta      RootNameStr
           adc      #$2805              +7 and H(ide)
           sta      HideNameStr
           adc      #$0B00              +7 and S(how)
           sta      ShowNameStr

           inc      7                   y set above
           inc      7
nameloop   lda      [7],y
           tyx
           sta      >FileName+2,x
           sta      >SrcFName+2,x
           sta      >EquFName+2,x
           sta      >FileNameTxt,x
           sta      >RootNameTxt,x
           sta      >HideNameTxt,x
           sta      >ShowNameTxt,x
           dey
           beq      nameloop
           dey
           bpl      nameloop

           plx
           lda      #$20                SPACE and NULL
           sta      >RootNameTxt,x
           lda      #$22                QUOTE and NULL
           sta      >HideNameTxt,x
           sta      >ShowNameTxt,x

           lda      SrcFName            Get the length of the file
           tax                          save it as is in x
           clc                          add 4 bytes for the suffix
           adc      #4
           cmp      #16                 now see if it's too long
           blt      setLength           br if not to long
           lda      #15                 set maxlength
setLength  sta      SrcFName            save new length
           sta      EquFName            save new length
           cpx      #12                 now was original too long
           blt      addSuffix           br if not too long
           ldx      #11                 save new start of suffix
addSuffix  lda      #$532e              ".S.."
           sta      >SrcFName+2,x
           lda      #$4352              "..RC"
           sta      >SrcFName+4,x
           lda      #$452e              ".E.."
           sta      >EquFName+2,x
           lda      #$5551              "..QU"
           sta      >EquFName+4,x

           PushLong #0
           PushLong #0
           PushLong #0
           PushLong #FileNameStr
           _ParamText
           ldx      #$4502
           jsl      shError2

           PushLong #HideNameStr
           PushWord #276
           _SetMItemName
           ldx      #$4510
           jsl      shError2

           PushLong #ShowNameStr
           PushWord #277
           _SetMItemName
           ldx      #$4511
           jsl      shError2

           PushWord #0
           PushWord #0
           PushWord #WindowMenuID
           _CalcMenuSize

           pld
           plb
           lda      2,s
           sta      10,s
           pla
           sta      7,s
           pla
           pla
           pla

           RTL

           END
******************************************************************************
NullWork   START
           using    Shell

           phb
           phk
           plb

purgeWork1 jsl      KillWork
           PushLong #1                  auxtype
           PushWord #$5e                 filetype
           PushWord #$c3
           PushLong #Scratch
           _CreateResourceFile          Now rebuild same
           bcc      exitNull

           cmp      #$2b                write protected?
           bne      createFail

           PushWord #0                  Result
           PushWord #4                  C str resource
           PushLong #0                  Substitution string
           PushLong #3
           _AlertWindow
           pla
           bra      purgeWork1
*          ---
createFail pha
           ldx      #$4610
           jsl      shError2
           pla
           sec
exitNull   plb
           rtl

******************************************************************************
KillWork   ENTRY

           phb
           phk
           plb

purgeWork  _DestroyGS P_KillWork
           bcc      exitKill
           cmp      #$2b                write protected?
           bne      exitKill

           PushWord #0                  Result
           PushWord #4                  C str resource
           PushLong #0                  Substitution string
           PushLong #3
           _AlertWindow
           pla
           bra      purgeWork

exitKill   plb
           rtl

P_KillWork dc       i2'1',i4'Scratch'

******************************************************************************
CopyWork   ENTRY

           phb
           phd
           phk
           plb
           tsc                                      11111
           pha                             12345678901234
           pld                          DP>dpbRTLtptrsptr

           lda      7                   grab target name pointer
           ldx      9                     o
           sta      TargetName            o
           stx      TargetName+2          o

           lda      11                  grab source name pointer
           ldx      13                    o
           sta      SourceName            o
           stx      SourceName+2          o

OpenFile   _OpenGS  OpenSource          open source file resource
           bcc      setSource
           brl      copyExit

setSource  lda      OpenSource+2
           sta      ReadParam+2
           sta      Close1+2

           PushLong #0                  this little piggy goes to market and
getIOMem   PushLong SourceEOF             returns the largest buffer needed
           PushWord MasterID              and available... uses divide-by-two
           PushWord #$C008                algorithm for memory allocation...
           PushLong #0
           _NewHandle
           bcc      ownIOMem            got some...
           cmp      #$201               can't allocate memory
           bne      cantGetMem          other memory error...
           lsr      SourceEOF+2
           ror      SourceEOF
           lda      SourceEOF+2
           bne      getIOMem
           lda      SourceEOF
           cmp      #1024               less than 1k and we have trouble!
           bge      getIOMem
***********
cantGetMem ldx      #$4710
           ply                          clean the stack
           ply
           brl      handler1
***********
ownIOMem   lda      SourceEOF           these values match the buffer size...
           ldx      SourceEOF+2           o
           sta      R_Request             o
           stx      R_Request+2           o
           sta      W_Count
           stx      W_Count+2

           phd                          now deref the handle on the stack and
           tsc                            set the buffer address in our IO
           pha                            blocks...
           pld                            o
           ldy      #2                    o
           lda      [3]                   o
           sta      R_Buffer
           sta      W_Buffer
           lda      [3],y
           sta      R_Buffer+2
           sta      W_Buffer+2
           pld

           PullLong IOhandle            save the handle for later

           _OpenGS  OpenTarget          open target file resource
           bcc      setTarget
           ldx      #$4722
           brl      handler2
***********
setTarget  lda      OpenTarget+2
           sta      WriteParam+2
           sta      Close2+2

readChunk  _ReadGS  ReadParam           read a buffer full
           bcc      writeChunk
           cmp      #$4c                EOF
           bne      handler4            out...
           lda      R_Transfer
           ldx      R_Transfer+2
           sta      W_Count
           ora      R_Transfer+2
           beq      fileIOdone
           stx      W_Count+2
writeChunk _WriteGS WriteParam          write a buffer full
           bcc      readChunk
           ldx      #$4731
           bra      handler3
handler4   ldx      #$4730
handler3   pha
           phx
           _CloseGS Close2
           plx
           pla

handler2   pha
           phx
           PushLong IOhandle
           _DisposeHandle
           plx
           pla
handler1   pha
           phx
           _CloseGS Close1
           plx
           pla
           sec
           bra      copyExit

fileIOdone PushLong IOhandle
           _DisposeHandle
           _CloseGS Close1
           _CloseGS Close2
           lda      #0
           clc
copyExit   sta      8
           stx      10                  DP>dpbRTLtAAXXptr
           lda      5                      12345678901234
           sta      13                     dpbRTLtAAXXpTL
           pld                             bRTLtAAXXpTL
           plb                             RTLtAAXXpTL
           pla                             LtAAXXpTL
           sta      7,s                    LtAAXXRTL
           pla                             AAXXRTL
           pla                             XXRTL      A set
           plx                             RTL        X set
           rtl

OpenSource dc       i2'14,0'
SourceName ds       4
           dc       i2'3,1'
           ds       38
SourceEOF  dc       i4'0'

OpenTarget dc       i2'4,0'
TargetName ds       4
           dc       i2'3,1'

ReadParam  dc       i2'4,0'
R_Buffer   dc       i4'0'
R_Request  dc       i4'0'
R_Transfer dc       i4'0'

WriteParam dc       i2'4,0'
W_Buffer   dc       i4'0'
W_Count    dc       i4'0,0'

Close1     dc       i2'1,0'
Close2     dc       i2'1,0'

IOhandle   ds       4

******************************************************************************
OpenWork   ENTRY

           phb
           phd
           phk
           plb

           PushWord #0                  Result space
           PushWord #$03                Access???
           PushLong #0                  Map address
           PushLong #Scratch            Need I say it?
           _OpenResourceFile
           bcc      fileValid
           ply
           pld
           plb
           rtl

fileValid  PullWord ResFileID

           PushWord #-1
           PushWord GenFileID
           jsl      SetResAccess

           PushLong #0                  Set up the root template
           PushLong #RootNameStr          o
           PushLong #refConHndl           o
           PushLong #DrawProc             o
           PushLong #0
           PushWord #0
           PushLong #rootWind
           PushWord #$800e
           _NewWindow2
           ldx      #$4808
           jsl      shError2
           PullLong RootWPtr

           PushLong RootWPtr
           _SetPort

           PushLong #0
           PushLong RootWPtr
           PushWord #3
           PushLong #rootCtrl
           _NewControl2
           ldx      #$480A
           jsl      shError2
           pla
           pla

           PushLong #0
           PushLong RootWPtr
           PushLong #3
           _GetCtlHandleFromID
           ldx      #$480B
           jsl      shError2
           PullLong TypeHandle

           PushLong #0
           PushLong RootWPtr
           PushLong #4
           _GetCtlHandleFromID
           ldx      #$480C
           jsl      shError2
           PullLong ItemHandle

           pld
           plb
ReOpenWork ENTRY
           phb
           phd
           phk
           plb

           jsl      InitTypeList        *** C ***

           PushLong #0
           PushLong TypeHandle
           _SortList2
           ldx      #$4810
           jsl      shError2

           PushLong #0
           PushLong ItemHandle
           _SortList2
           ldx      #$4811
           jsl      shError2

           PushLong #IdleMenuList
           PushWord #0                  Disable
           jsl      SetMenus

           PushLong #LiveMenuList
           PushWord #-1                 Enable
           jsl      SetMenus

           jsl      CheckHide

*           PushLong #EditMenuList
*           PushWord #-1                 Enable
*           jsl      SetMenus

           lda      #PopItemID           Default... Item: Edit
           sta      Action

           _InitCursor

           lda      #0
           pld
           plb
           rtl

           END

******************************************************************************
ForkProc   START                        Stack at entry
           using    Shell

           phd
           tsc
           pha
           pld

           ldx      #1                  Set invalid files to dimmed default
           ldy      #4
           lda      [6],y               flags
           bpl      ExitProc            Branch if not extended or directory
           inx                          Otherwise, set to allow selection
           bra      ExitProc

ImportProc ENTRY                       Stack at entry
           using    Shell

           phd
           tsc
           pha
           pld

           ldx      #1                  Set invalid files to dimmed default
           ldy      #$4
           lda      [6],y               flags
           bmi      ExitProc            Branch if not extended or directory
           ldy      #$14
           lda      [6],y               eof hi-word - Res can't be > $ffff
           bne      ExitProc
           inx                          Otherwise, set to allow selection

ExitProc   stx      10                  Set result word

           pld
           lda      2,s
           sta      6,s
           pla
           sta      3,s
           pla
           rtl

DrawProc   ENTRY

           phd
           phb
           phk
           plb

           PushWord #0                  Drawing DefProc for root Window
           _GetCurResourceFile
           PushWord GenFileID
           _SetCurResourceFile
           PushLong #0
           _GetPort
           _DrawControls
           _SetCurResourceFile

           plb
           pld

NullProc   ENTRY
           RTL

           END


ViewSource START
*****************************************************************
*
*****************************************************************
*
           phd
           phb
           phk
           plb

           PushLong #0
           _GetFirstWindow
           ldx      #$4902
           jsl      shError2

findView   pla
           sta      tempW
           pla
           sta      tempW+2
           ora      tempW
           beq      openView

           PushLong tempW
           jsl      RefConSetup
           cmp      #$5754
           bne      not_View

           PushLong tempW
           _SelectWindow
           ldx      #$4906
           jsl      shError2
           bra      exitView

not_View   PushLong #0                  Get the next sucker
           PushLong tempW                 o
           _GetNextWindow                 o
           ldx      #$4908
           jsl      shError2
           bra      findView            More pain...

openView   jsl      doOpenWindow

exitView   plb
           pld
           rtl

tempW      ds       4

           END

CloseRoot  START
*****************************************************************
*
*   CloseRoot
*
*****************************************************************
*
           using    Shell

           phb
           phd
           phk
           plb

           lda      ChangedFlag
           ora      NewFileFlag
           beq      noSave

           PushWord #0                  Result
           PushWord #4                  C str resource
           PushLong #0                  Substitution string
           PushLong #5
           _AlertWindow                 This will return 0, 1 or 2
           pla
           bne      checkDeath          br = yes or no
           brl      ExitClose           cancel... abort the quit

checkDeath cmp      #2                  else it's yes or no
           bne      noSave              br = no

           jsl      SaveRez
           cpy      #0
           beq      noSave

           lda      #0                  canceled save
           brl      ExitClose

noSave     _WaitCursor

           jsl      CloseEds

           PushWord ResFileID
           _CloseResourceFile
           ldx      #$4A02
           jsl      shError2

           jsl      KillList            Kill mem for the lists

           PushLong RootWPtr
           _CloseWindow
           ldx      #$4A04
           jsl      shError2

           jsl      CloseFileMenuHi      De-Hilite menus for editing

           stz      ChangedFlag
           stz      NewFileFlag
           stz      RHidingFlag

           _InitCursor

           jsl      KillWork

           lda      QuitFlag

ExitClose  pld
           plb
           RTL

           END

CloseEds   START
*****************************************************************
*
*   CloseEds closes all editor windows
*
*****************************************************************
*
           using    Shell

           phb
           phd
           phk
           plb
           lda      #$400              Set countdown to insanity value
           sta      numTimes

           PushLong #0
           _GetFirstWindow
           ldx      #$4B02
           jsl      shError2

ShutLoop   lda      1,s
           sta      tempW
           lda      3,s
           sta      tempW+2
           ora      1,s
           beq      EndCloseEd          Branch if we've closed 'em all

           jsl      RefConSetup
           bmi      NextWind            branch if root or an nda window
           and      #$ff00              "-*"
           cmp      #$5700              "?W"
           beq      NextWind
           lda      SMURF+ResourceType  Is the front window an editors?
           beq      NextWind

           PushLong tempW
           _BringToFront                Else, get this sucker
           ldx      #$4B04
           jsl      shError2

           ldx      #4                  Set up Shutdown command
           stx      SMURF+EditCommand

           jsr      RTDispatch          Kill one

NextWind   dec      numTimes            Tick Tock
           beq      BreakDown

StillSane  PushLong #0                  Get the next sucker
           PushLong tempW                 o
           _GetNextWindow                 o
           ldx      #$4B06
           jsl      shError2
           bra      ShutLoop            More pain...

BreakDown  PushLong #0                  Result (normally a word - see below)
           PushWord #4                  C str resource
           PushLong #0                  Substitution string
           PushLong #7
           _AlertWindow                 This is right... if we enter through
EndCloseEd pla                          BreakDown we should make the stack as
           pla                          congested as is normal through the
           pld                          EndCloseEd (grafportptr on the stack)
           plb
           RTL

numTimes   dc i2'0'
tempW      ds 4

           END

doQuit     START
*****************************************************************
*
*   doQuit
*
*   Outputs: QuitFlag set to -1
*
*****************************************************************
*
           using    Shell

           phb
           phd
           phk
           plb
           dec      QuitFlag            regular quit -1
           bra      QuitCommon

doQuitTo   ENTRY

           phb
           phd
           phk
           plb

           inc      QuitFlag            transfer quit 1

QuitCommon PushLong #0
           _GetFirstWindow
           ldx      #$4C02
           jsl      shError2

findRoot   pla
           sta      tempW
           pla
           sta      tempW+2
           ora      tempW
           beq      noRoot             branch if there's no root!

           PushLong tempW
           jsl      RefConSetup
           cmp      #$5752
           beq      killRoot

           PushLong #0                  Get the next sucker
           PushLong tempW                 o
           _GetNextWindow                 o
           bra      findRoot            More pain...

killRoot   PushLong tempW
           _SelectWindow                Else, get this sucker
           ldx      #$4C04
           jsl      shError2
           jsl      CloseRoot           Its ours, Close up shop
           sta      QuitFlag            quit MAY be overridden here!
           cmp      #0
           bne      noRoot              (that's quite literal now!)

exitQuit   pld
           plb
           RTL

noRoot     PushLong #0
           _GetFirstWindow
           ldx      #$4C06
           jsl      shError2

findWind   pla
           sta      tempW
           pla
           sta      tempW+2
           ora      tempW
           beq      exitQuit            banch if we've closed 'em all

           PushLong tempW
           jsl      RefConSetup
           cmp      #$5751              "QW"
           bne      notHelp
           PushLong tempW
           _BringToFront
           ldx      #$4C08
           jsl      shError2
           jsl      closeHelpWin
           bra      nextWind

notHelp    cmp      #$5754              "SW"
           bne      notView
           PushLong tempW
           _BringToFront
           ldx      #$4C0A
           jsl      shError2
           jsl      closeTEWin
           bra      nextWind

notView    and      #$ff00              "-*"
           cmp      #$5700              "?W"
           bne      nextWind

           PushLong tempW
           _BringToFront
           ldx      #$4C0C
           jsl      shError2
           PushLong tempW
           _CloseWindow
           ldx      #$4C0D
           jsl      shError2

nextWind   PushLong #0                  Get the next sucker
           PushLong tempW                 o
           _GetNextWindow                 o
           ldx      #$4C0E
           jsl      shError2
           brl     findWind           More pain...

SetQuitApp ENTRY

           phb
           phk
           plb

           PushLong #0
           _GetPort
           PushWord #120                Ask user for file to open
           PushWord #30
           PushWord #0                  IsPointer
           PushLong #QuitPrompt
           PushLong #0
           PushLong #quitFiles
           PushLong #NewReply
           _SFGetFile2
           ldx      #$4C80
           jsl      shError2
           _SetPort

           ldx      #0
           lda      NewReply
           beq      quitCancel

           PushLong #I1PName
           pla
           plx

quitCancel plb
           rts

quitFiles  dc       i2'2'
           dc       i2'$8000,$b3',i4'0'
           dc       i2'$8000,$ff',i4'0'

tempW      ds 4

           END

doUpdate   START
*****************************************************************
*
*   doUpdate
*
*****************************************************************
*
           phd
           phb
           phk
           plb

           PushLong #0
           _FrontWindow
           ldx      #$4D02
           jsl      shError2
           jsl      RefConSetup
           lda      SMURF+ResourceType
           beq      exitUpdate

           lda      #7                  Set UpdateResource command
           sta      SMURF+EditCommand
           jsr      RTDispatch

exitUpdate plb
           pld
           rtl

           END

IODialog   START
*****************************************************************
*
*   IODialog
*
*   Inputs: stack contains a pointer to a dialog template
*
*   Outputs: A/X contain the dialog pointer
*
*****************************************************************
*
           using Shell

           phb
           phd
           phk
           plb
*                                          12345678901234
           lda      9,s                 tr dpbRTLtptr....
           pha                             trdpbRTLtptr..
           lda      9,s                 tp
           pha                             tptrdpbRTLtptr
           lda      9,s                 TL
           sta      13,s                   tptrdpbRTLtpTL
           lda      7,s                 bR
           sta      11,s                   tptrdpbRTLbRTL
           lda      5,s                 dp
           sta      9,s                    tptrdpbRdpbRTL
           _WaitCursor
           _GetNewModalDialog              dptrdpbRTL
           lda      3,s                 tr
           tax
           lda      1,s                 dp
           phx                             trdptrdpbRTL
           pha                             dptrdptrdpbRTL
           phx                             trdptrdptrdpbRTL
           pha                             dptrdptrdptrdpbRTL
           _SetPort                        dptrdptrdpbRTL
           _DrawDialog                     dptrdpbRTL
           pla                             trdpbRTL
           plx                             dpbRTL
           pld
           plb

           RTL

           END

checkDisk  START
*****************************************************************
*
*   checkDisk
*
*   Inputs:         Stack: word flag 0 ok only, 1 ok/cancel
*                          long c1input pointer
*
*   Outputs:        accumulator 0 ok/good, -1 cancel
*
*****************************************************************
*


           phd
           phb                          bdprtlNAMEfl
           phk                          123456789012
           plb

           lda      7,s
           sta      Expand+2
           lda      9,s
           sta      Expand+4
           _ExpandPathGS Expand
           ldx      #$4F02
           jsl      shError2

           ldy      Path+2
           sty      Name
           dey
nextChar   lda      Path+4,y
           sta      Name+2,y
           pha
           and      #$ff
           cmp      #$3a
           bne      saveChar
           sty      Name
           lda      #0
           sta      1,s
saveChar   pla
           sta      Text,y
           dey
           beq      lastChar
           bpl      nextChar
lastChar   lda      Path+4
           sta      Name+2
           sta      Text

           PushWord #0
           _GetCurResourceFile          This leaves the curResFile on the stack
           ldx      #$4F06
           jsl      shError2
           PushWord GenFileID
           _SetCurResourceFile
           ldx      #$4F07
           jsl      shError2

diskLoop   _WaitCursor

           _GetFileInfoGS GFInfo
           bcc      exitGood

           _InitCursor

           PushWord #0
           PushWord #4                  cStr resource %100
           PushLong #Params

           lda      21,s                This is the flag offset
           beq      noCancel

           PushLong #$0000000E
           bra      getAlert

noCancel   PushLong #$0000000F

getAlert   _AlertWindow
           pla
           beq      diskLoop

           lda      #-1

exitGood   sta      10,s                rfbdprtlN??Efl
           _SetCurResourceFile          bdprtlN??Efl
           ldx      #$4F08
           jsl      shError2
           plb                          1234567890
           pld                          rtlN??Efl
           lda      2,s
           sta      8,s                 rtlN??Etl
           pla
           sta      5,s                 lN??rtl
           pla                          ??rtl
           pla                          rtl
           rtl

Expand     dc       i2'2',i4'0,Path'
GFInfo     dc       i2'2',i4'Name',i2'0'

Params     dc       i4'Text,0,0,0,0,0,0,0,0,0'

Path       dc       i2'256,0'
           ds       256
Name       dc       i2'0'
           ds       256
Text       ds       256

           END

GenSrc     START
*****************************************************************
*
*             H I S T O R I C A L   M A R K E R
*
*  At this spot on November 12, 1989, the first successful code
*  generation from the Genesys Shell occured.  P U R E   S E X
*
*****************************************************************
*
           using    Shell

           phb
           phd
           phk
           plb

           jsl      doUpdate
           lda      Member
           bne      IDset

           jsl      DoChooseLang

IDset      stz      eRecFlag            Assume source output
           PushLong #SrcPrompt
           PullLong SFprompt
           PushLong #SrcFName
           PullLong SFname

           lda      SMURF+wmTaskData    Get the item ID of menu item selected.
           cmp      #FileCreateID       Was it really source?
           beq      setSource           Yep

           lda      #$8000              Nope.. set equate flag
           sta      eRecFlag
           PushLong #EquPrompt
           PullLong SFprompt
           PushLong #EquFName
           PullLong SFname

setSource  PushLong #0
           _GetPort
           PushWord #160
           PushWord #30
           PushWord #0                  Next param is Pointer
           PushLong SFprompt
           PushWord #0                  Next param is Pointer
           PushLong SFname
           PushLong #NewReply
           _SFPutFile2
           ldx      #$5002
           jsl      shError2
           _SetPort
           lda      NewReply
           beq      cancelGen

           PushLong #0                 |- new for segmented engine
           PushLong #0                 |
           PushWord #-1                Update..Kind set for loading prompt
           PushWord eRecFlag           Special for displaying source/equates
           PushWord #0                 |- the rest don't matter
           PushWord #0                 :
           PushWord #0
           PushLong #0
           PushWord #0
           jsl      update

           lda      ResFileID
           sta      eRecRes
           lda      MasterID
           sta      eRecMem
           PushLong #I1UName
           PullLong eRecord

           PushLong #eRecord
           jsl      Engine
           jsl      ErrMsg
           PushWord #-1
           PushWord GenFileID
           jsl      SetResAccess
           lda      #0
cancelGen  pld
           plb
           RTL

DoChooseLang ENTRY
*****************************************************************
*
*   DoChooseLang
*
*****************************************************************
*
           using    Shell

           phb
           phd
           phk
           plb

           PushLong #0
           _GetPort

           PushLong #0                  Space for result
           PushLong #0                  Ptr to window title
           PushLong #0                  RefCon
           PushLong #DrawProc
           PushLong #0                  Window Def Proc
           PushWord #0                  Next param is ptr
           PushLong #ChooserWin         Ptr to window data
           PushWord #$800E              Type is window
           _NewWindow2
           ldx      #$5102
           jsl      shError2
           PullLong dialogPtr

           PushLong dialogPtr
           _SetPort

           PushLong #0                    GCH space
           PushLong dialogPtr             GCH wptr
           PushLong #2                    GCH id (list)
           _GetCtlHandleFromID
           ldx      #$5106
           jsl      shError2
           pla
           plx
           sta      ListHandle
           stx      ListHandle+2

           lda      Member
           bne      MemberSet
           lda      #1
MemberSet  pha
           PushLong ListHandle
           _SelectMember2
           ldx      #$5108
           jsl      shError2

           PushLong dialogPtr
           _ShowWindow
           ldx      #$510A
           jsl      shError2

cLoop      PushWord #0
           PushWord #$ffff
           PushLong #myTask
           _TaskMaster
           pla
           cmp      #wInDrag
           bne      chkButton

           PushLong #myRect
           PushWord #0
           PushWord #0
           PushWord #639
           PushWord #199
           _SetRect
           ldx      #$5110
           jsl      shError2

           PushWord #0
           PushWord where+2
           PushWord where
           PushWord #8
           PushLong #myRect
           PushLong TaskData
           _DragWindow
           ldx      #$5112
           jsl      shError2

chkButton  cmp      #wInControl
           bne      cLoop

           lda      TaskData4
           cmp      #1                  button
           beq      hitButton

           cmp      #2                  list
           bne      cLoop

           lda      ClickCnt            get the current click count
           cmp      #2                  is it a double click?
           beq      chkParts            br = yes
cLoop2     bra      cLoop

chkParts   lda      TaskData3           See if part code isn't one of these...
           cmp      #5                  List up arrow
           beq      cLoop2
           cmp      #6                  List down arrow
           beq      cLoop2
           cmp      #7                  List page up
           beq      cLoop2
           cmp      #8                  List page down
           beq      cLoop2
           cmp      #$81                List thumb
           beq      cLoop2

hitButton  PushWord #0
           PushLong ListHandle
           _ResetMember2
           ldx      #$5120
           jsl      shError2
           pla
           sta      Member

           PushLong #0
           PushWord Member
           PushWord #7
           _Multiply
           ldx      #$5121
           jsl      shError2
           pla
           plx
           dec      a
           dec      a
           tax
           lda      LangData,x
           sta      eRecLang
           stz      eRecLang+2

           PushLong dialogPtr
           _CloseWindow
           ldx      #$5124
           jsl      shError2

           _SetPort
           pld
           plb

           RTL

dialogPtr  ds       4
myRect     ds       8
ListHandle ds       4
Member     dc       i2'0'

myTask     anop
what       dc       i2'0'
message    dc       i4'0'
when       dc       i4'0'
where      dc       i4'0'
modifiers  dc       i2'0'
TaskData   dc       i4'0'
TaskMask   dc       i4'$1B2006'
ClickTick  dc       i4'0'
ClickCnt   dc       i2'0'
TaskData2  dc       i4'0'
TaskData3  dc       i4'0'
TaskData4  dc       i4'0'
ClickPnt   dc       i4'0'

eRecord    dc       i4'0'
eRecRes    dc       i2'0'
eRecMem    dc       i2'0'
eRecLang   dc       i4'0'
           dc       i2'0'
eRecFlag   dc       i2'0'

SFprompt   ds       4
SFname     ds       4

           END

rNameBuild START M_WOLFGRAM
*****************************************************************
*
*   rNameBuild      fast assed rName resource data cruncher
*
*   Inputs:         long rName pString pointer
*                   long rID
*                   long rName stream pointer
*
*   Outputs:        long rName stream pointer
*
*****************************************************************
*                            111111111
*                   123456789012345678
           phd      bdpRTLSptrRID_Nptr
           phb
           phk
           plb
           tsc
           tcd

           lda      11
           sta      [7]
           inc      7
           inc      7
           lda      13
           sta      [7]
           inc      7
           inc      7

           lda      7
           sta      11
           lda      9
           sta      13

           lda      [15]
           and      #$ff
           tay
copyChar   lda      [15],y
           sta      [11],y
           inc      7
           bne      nextChar
           inc      9
nextChar   dey
           bpl      copyChar                0000000001111111
*                                           1234567890123456
           pla                          bd  pRTLSptrRID_Nptr
           sta      11,s                    pRTLSptr..bdNptr
           pla                          pR  TLSptrRID_Nptr
           sta      11,s                    TLSptr..bdpRtr
           pla                          TL  SptrRID_Nptr
           sta      11,s                    Sptr..bdpRTL
           pla                          Sp  tr..bdpRTL
           plx                            tr..bdpRTL
           ply                          ..  bdpRTL
           plb                          b   dpRTL
           pld                          dp  RTL
           rtl                          RTL

           END

ImportFile START
****************************************************************
*
*
****************************************************************
*
           using    Shell

           phb
           phk
           plb

           PushLong #0
           _GetPort
           PushWord #120                Ask user for file to open
           PushWord #30
           PushWord #0                  IsPointer
           PushLong #ImpPrompt
           PushLong #ImportProc         This dehi's extended and files > 64k
           PushLong #0
           PushLong #NewReply
           _SFGetFile2
           ldx      #$5300
           jsl      shError2
           _SetPort

           lda      NewReply
           beq      ImportExit

           PushLong #I1UName            Class 1 Input string
           PushLong #I1PName            Class 1 Input string
           jsl ImportRez

ImportExit plb
           rtl

           END
