*****************************************************************
*
*   Apple: About Genesys...             doAbout
*
*   Edit:  Undo
*          Cut
*          Copy
*          Paste
*          Clear
*          Show Clipboard
*
*   Misc:  InstEditors
*
*          Copyright 1989, 1990
*          Simple Software Systems International, Inc.
*
*          ALL RIGHTS RESERVED
*
* Marc Wolfgram,  1 Apr 89
*
*****************************************************************
*
           case     on

           copy     e16.genesys

           mcopy    apple.mac

doAbout    START
*****************************************************************
*
*   DoAbout    Displays "About GENESYS..." dialog box selected
*              from the Apple menu
*
*****************************************************************
*
           using    Shell

           phd
           phb                             123456
           phk                          123456789
           plb                          bdpRTLsptr

           PushLong #0                  save port on stack
           _GetPort

           lda      11,s
           ora      13,s
           bne      StartNote

           lda      #$2020
           sta      MemStr
           sta      MemStr+2

           PushLong #0                  LongDivide remainder_result
           PushLong #0                  LongDivide quotient_result
           PushLong #0                   RealFreeMem byte_result
           _RealFreeMem                  LongDivide dividend
           ldx      #$2002
           jsl      shError2
           PushLong #1024               LongDivide divisor
           _LongDivide                  Long2Dec long_value
           ldx      #$2003
           jsl      shError2
           PushLong #MemStr             Long2Dec String
           PushWord #4                  Long2Dec Size
           PushWord #0                  Long2Dec Unsigned
           _Long2Dec
           ldx      #$2004
           jsl      shError2
           pla                          now we finally discard...
           pla                            ...the remainder_result

           PushLong #0
           _FrontWindow
           ldx      #$2006
           jsl      shError2
           jsl      RefConSetup
           lda      SMURF+ResourceType
           bne      vEditor

           PushLong #ShellRev
           bra      vIsDone

StartNote  lda      13,s
           pha
           lda      13,s
           pha
           bra      vIsDone

vEditor    lda      #1
           sta      SMURF+EditCommand
           jsr      RTDispatch
           PushLong SMURF+EditResult

vIsDone    anop

           PushLong #0                  Space
           PushLong #0                  Title
           PushLong #0                  Refcon
           PushLong #DrawProc
           PushLong #0                  DefProc
           PushWord #2                  Is resource
           PushLong #4093
           PushWord #$800E
           _NewWindow2
           ldx      #$2010
           jsl      shError2
           PullLong ADialogP

           PushLong ADialogP
           _SetPort

           PushLong #0
           PushLong ADialogP
           PushLong #1
           _GetCtlHandleFromID           Resulting ctrl handle is on stack...
           ldx      #$2011
           jsl      shError2

           PushLong ADialogP
           _ShowWindow
           ldx      #$2012
           jsl      shError2

           _DrawOneCtl                  ...and is used by this puppy!
           ldx      #$2013
           jsl      shError2

           PushWord #15
           PushWord #96
           _MoveTo

           PushWord #$0000
           _SetBackColor
           PushWord #$FFFF
           _SetForeColor

           _DrawString                  STRING ON STACK

           lda      11,s
           ora      13,s
           bne      AboutOut

           PushWord #0
           PushLong #MemStr
           _CStringWidth
           pla
           sta      temp
           lda      #423
           sec
           sbc      temp
           pha
           PushWord #96
           _MoveTo

           PushLong #MemStr
           _DrawCString                  STRING ON STACK

NotYet     pha
           PushWord #$FFFF
           PushLong #OurEvent
           _GetNextEvent
           pla
           beq      NotYet
           lda      OurEvent
           cmp      #1
           beq      Yet
           cmp      #3
           bne      NotYet

Yet        PushLong ADialogP            Close the information dialog
           _CloseWindow
           ldx      #$2020
           jsl      shError2

AboutOut   PushWord #$FFFF
           _SetBackColor
           PushWord #$0000
           _SetForeColor

           _SetPort                     restore port on stack

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

           RTL

doMenuAbout ENTRY

           phd
           phb
           phk
           plb

           PushLong #0
           jsl      doAbout

           plb
           pld
           lda      #0
           clc

           RTL

temp       ds       2

MemStr     dc       c'   0k free memory',h'00'

OurEvent   ds       16

           END

EdUndo     START
EdCut      ENTRY
EdCopy     ENTRY
EdPaste    ENTRY
EdClear    ENTRY
*****************************************************************
*
*
*
*   Inputs:
*
*   Outputs:
*
*****************************************************************
*
           phd
           phb
           phk
           plb

           ldx      #EditRes            Set up Edit Resource command 2
           stx      SMURF+EditCommand
           jsr      RTDispatch          Dispatch call to Editor

           plb
           pld
           rtl

           END

ShowClip   START
*****************************************************************
*
*   ShowClip
*
*****************************************************************
*
           phd
           phb
           phk
           plb

           PushLong #0
           _GetFirstWindow
           ldx      #$2702
           jsl      shError2

findClip   pla
           sta      tempW
           pla
           sta      tempW+2
           ora      tempW
           beq      openClip

           PushLong tempW
           jsl      RefConSetup
           cmp      #$5753
           beq      popClipW

           PushLong #0                  Get the next sucker
           PushLong tempW                 o
           _GetNextWindow                 o
           ldx      #$2704
           jsl      shError2
           bra      findClip            More pain...

popClipW   PushLong ClipWPtr
           _SelectWindow
           ldx      #$2706
           jsl      shError2
           bra      exitClip

openClip   PushLong #0                  Space
           PushLong #0                  Title
           PushLong #ClipRefCon         Refcon
           PushLong #ClipProc
           PushLong #0                  DefProc
           PushWord #2                  Resource
           PushLong #$FFF               ID
           PushWord #$800E
           _NewWindow2
           ldx      #$2708
           jsl      shError2
           PullLong ClipWPtr

           PushLong ClipWPtr
           _SetPort

           PushWord #$FFFE
           PushLong ClipWPtr
           _SetOriginMask

exitClip   plb
           pld
           rtl

ClipEvent  ENTRY ************************************************

           phd
           phb
           phk
           plb

           PushWord #0
           _GetScrapCount
           ldx      #$2710
           jsl      shError2
           pla
           cmp      ClipCount
           beq      exitEvent

           sta      ClipCount           Reset to prevent loopus infinitum

           lda      ClipWPtr
           ora      ClipWPtr+2
           beq      exitEvent

           PushLong #0
           _GetPort
           PushLong ClipWPtr
           _SetPort
           PushLong #ClipRect
           _GetPortRect
           PushLong #ClipRect
           _EraseRect
           PushLong #ClipRect
           _InvalRect
           _SetPort

exitEvent  plb
           pld
           RTL

closeClip  ENTRY ************************************************

           PushLong ClipWPtr
           _CloseWindow
           ldx      #$2720
           jsl      shError2
           stz      ClipWPtr
           stz      ClipWPtr+2

           RTL

ClipProc   ENTRY ************************************************

           phd
           phb
           phk
           plb

           PushWord #0                  Drawing DefProc for root Window
           _GetCurResourceFile
           ldx      #$2802
           jsl      shError2
           PushWord GenFileID
           _SetCurResourceFile
           ldx      #$2803
           jsl      shError2

           PushLong #0                  The space for result for 2 GSH calls

           PushWord #0                  Text
           _GetScrapHandle
           bcs      not_Text

           PushLong #ClipRect
           _GetPortRect

           PushLong #0
           PushLong ClipWPtr
           _GetContentOrigin
           pla                          vert
           sta      tempW
           sec
           lda      ClipRect
           sbc      tempW
           sta      ClipRect
           pla                          horiz
           sta      tempW
           sec
           lda      ClipRect+2
           sbc      tempW
           sta      ClipRect+2

*           PushLong #0
*           PushLong ClipWPtr
*           _GetContentOrigin
*           pla            negate y value
*           eor      #$FFFF
*           inc      a
*           tay
*           pla
*           eor      #$FFFF
*           inc      a
*           tax
*           PushLong ClipRect
*           phx
*           phy
*           _OffsetRect

           phd                          Warning: frame logic...
           tsc
           tcd
           ldy      #2                  ...Convert the handle...
           lda      [3],y
           tax
           lda      [3]
           sta      3                   ...to a pointer to text...
           stx      5
           pld                          ...end of frame:  TEXT POINTER ON STACK
           PushLong #0
           PushWord #0
           _GetScrapSize
           pla
           sta      1,s                                   LENGTH  WORD ON STACK
           PushLong #ClipRect                             RECT POINTER ON STACK
           PushWord #0                                    LEFT JUSTIFY
           _LETextBox
           bra      ProcExit

not_Text   PushWord #1                  Picture
           _GetScrapHandle
           bcs      not_Pict

           lda      3,s
           pha
           lda      3,s
           pha

           phd                          Warning: frame logic...
           tsc
           tcd
           ldy      #2                  ...Convert the handle...
           lda      [3],y
           tax
           lda      [3]
           sta      3                   ...to a pointer to the picture...
           stx      5

           ldy      #8
moveRect   lda      [3],y
           dey
           dey
           sta      ClipRect,y
           cpy      #0
           bne      moveRect

           pld                          ...end of frame
           pla
           pla

           PushLong #ClipRect
           _DrawPicture
           bra      ProcExit

not_Pict   pla                         Nothing
           pla

           lda      #10
           pha
           pha
           _MoveTo
           PushLong #MTClip
           _DrawString

ProcExit   _SetCurResourceFile
           ldx      #$2882
           jsl      shError2

           plb
           pld
           RTL

MTClip     str      'Clipboard empty...'

ClipRect   ds       8
TextRect   ds       8

ClipRefCon dc       I4'ClipRefDat'
ClipRefDat dc       I2'0',I4'0',I2'$5753',I4'0'  ScrapWindow SW

tempW      ds       4

           END

InstEditors START
*****************************************************************
*
*   InstEditors
*
*****************************************************************
*
           using    Shell
           tsc
           sta      ExitStack

           stz      ECNT                Number of loaded editor is 0

           PushLong #ETXT               copying ptr to pop-up menu strs...
           PullLong MenuAddr            into here

           _OpenGS  OpenDir             First, open the editor directory
           bcc      DirOpen             br = no error
           cmp      #$46                file_not_found
           bne      OpenErr              - now is a -
           lda      #$44                path_not_found
OpenErr    jsl      ErrMsg
           lda      #-1
           sta      QuitFlag
           rts

DirOpen    lda      OpenDir+2           Move our file refnum around
           sta      FEntry+2
           sta      CloseDir+2

NextDir    lda      #32                 This restores the path buffer length
           sta      FEntBuf                           $32 00 trash...
           _GetDirEntryGS FEntry        Read a file entry from directory
           bcc      HaveDir
           cmp      #$61                End_of_directory?
           beq      EODir               Yep...

LoadErr    ldx      #$2FFF
           jsl      shError2
           lda      ExitStack
           tcs

EODir       _CloseGS CloseDir
           ldx      #$2F02
           jsl      shError2
           brl      EndLoad             Yep. we're done loading!

HaveDir    lda      FEntType            Get the file type
           cmp      #$00BC              "Generic Load" file ?
           bne      NextDir             Nope, back for another...
           lda      FEntAuxT            AuxType...
           cmp      #$4003              "Genesys Editor" ?
           bne      NextDir                  back, back, back I say!
           lda      FEntAuxT+2          ...hi word should be NULL
           bne      NextDir                  ...for another...

           lda      FEntBuf+2           $32 $00 L+0 $00 name....
           inc      a                   L+1
           inc      a                   L+2
           sta      FEntBuf             L+2 $00 L+0 $00 name...
           lda      #$3a36              in memory this becomes ascii "6:"
           sta      FEntBuf+2           L+2 $00 6:name...

           PushWord #0                  result
           PushWord #3                  access: rw
           PushLong #0                  map address
           PushLong #FEntBuf            path
           _OpenResourceFile
           ply
           bcc      validRes
           ldy      #0
validRes   sty      SMURF+ResourceFileID

           lda      FEntBuf             L+2 $00 6/name...
           xba
           sta      FEntBuf             $00 L+2 6/name...

           PushWord #0                  size of direct page/stack buffer
           PushWord #0                  addr direct page/stack buffer
           PushLong #0                  space for start address
           PushWord #0                  space for returned id
           PushWord #$1000              get a new user id for this editor
           PushLong #FEntName           address of loadfile pathname
           PushWord #$ffff              non-zero = dont load to special memory
           _InitialLoad                 load it

           tay
           PullWord TempID              get editors userID for shutdown
           PullLong Addr                get editors starting address
           PLA                          pull dirPAddr, dont need, dont store
           PLA                          pull dirPSize, dont need, dont store

           BCC      LoadOk              br = no error
           phy
           PushWord #0
           PushWord TempID
           _UserShutdown
           pla
           pla
           BRL      LoadErr             br = error

LoadOk     lda      #EditStart          Editor Startup Command 3
           sta      SMURF+EditCommand   store in smurf

           stz      SMURF+EditResult2   Zap the menu pointer prior to editor
           stz      SMURF+EditResult2+2   call for compatability with pre a23

           phb                          Our data bank
           pushlong #SMURF              push smurf on stack
           phk
           pea      RTLback-1           Our "rtl" address (two bytes)

           SHORTM                       Our "jsl" address
           lda      Addr+2              *
           pha                          *
           pha                          * This one's the future data bank
           LONGM                        *
           sec
           lda      Addr
           sbc      #1
           plb                          Like I said...
           pha

           rtl                          When a rtl is really a jsl...

RTLback    plx                          See if we need to restore the stack
           ply                            o
           cpx      #<SMURF               o
           bne      Its_done              o
           cpy      #^SMURF
           beq      We_do_it

Its_done   phy                          No... they did it so put it back
           phx

We_do_it   ANOP
           plb                          Our data bank

           lda      SMURF+EditResult2
           ora      SMURF+EditResult2+2
           beq      NoMenuPtr           A = 0
           lda      #-1                 A = -1
NoMenuPtr  sta      MenuFlag
           pha

           lda      SMURF+EditResult
           ora      SMURF+EditResult+2
           bne      NotGeneric

           lda      #$8000
           sta      GEDloaded

           ldx      #128                EMAX = 64 (0..63), as word EMAX+1 = 128
           lda      TempID
           sta      EUID,x

           ldx      #256                EMAX = 64 (0..63), as long EMAX+1 = 256
           lda      Addr
           sta      EADR,x
           lda      Addr+2
           sta      EADR+2,x

           pla
           beq      EndGeneric

           lda      SMURF+EditResult2
           sta      ENM2,x
           lda      SMURF+EditResult2+2
           sta      ENM2+2,x

EndGeneric brl      NextDir

NotGeneric pla
           jsr      InitMulti

NextType   lda      ECNT                Number of editors loaded
           beq      NewEdit             br = installing 1st editor
           asl      A                   index * 2
           tax                          put in X

CheckIt    dex                          Already have the same editor?
           dex
           bmi      NewEdit
           lda      ERES,x
           cmp      SMURF+ResourceType
           bne      CheckIt             br = no
           brl      SkipEntry

NewEdit    lda      ECNT                redundant
           asl      A                   turn into word wide index
           tax

           lda      TempID              put the editors userID in the table
           sta      EUID,x                so it can be used for UserShutdown
           stz      TempID                but put it there only once (multi)

           clc
           lda      ECNT
           adc      #$1000
           sta      EMID,x

           inc      ECNT

           lda      SMURF+ResourceType
           sta      ERES,x

           txa
           asl      A                   turn into long wide index
           tax

           lda      Addr
           sta      EADR,x
           lda      Addr+2
           sta      EADR+2,x
           phx                          THIS INDEX WILL BE USED IN A SECOND

           PushLong SMURF+EditResult    set up menu string
           PushLong MenuAddr    
           PushLong #32
           _BlockMove

           clc                          make a menu ID
           lda      MenuAddr    
           adc      #32
           sta      MenuAddr    
           lda      MenuAddr    +2
           adc      #0
           sta      MenuAddr    +2

           plx                          RESTORE INDEX TO TABLES
           lda      MenuFlag            Is there a possible menu?
           sta      ENM2,x              Assume not...
           sta      ENM2+2,x
           beq      SkipEntry           Really branch if not...

           lda      SMURF+EditResult2   Now grab the editors menu pointer
           sta      ENM2,x
           lda      SMURF+EditResult2+2
           sta      ENM2+2,x

SkipEntry  jsr      NextMulti
           beq      MultiDone
           brl      NextType
MultiDone  brl      NextDir

EndLoad    anop
           PushLong #SortProc           qsort(,,,*SortProc())
           PushLong #4                  qsort(,,4L,*SortProc())
           lda      #0
           pha
           lda      ECNT
           pha                          qsort(,ECNT,4L,*SortProc())
           PushLong #EMEN+10            qsort(*EMEN.EMTB,ECNT,SortProc())
           jsl      qsort

           lda      ECNT                turn ecount in long index
           asl      a                   *2
           asl      a                   *4
           tax
           lda      #0
           sta      EMEN+10,x           Formerly EMTB (same as EMEN+10)
           sta      EMEN+12,x

           stz      SMURF+ResourceType  Init res type
           RTS

InitMulti  sta      ValidMenu
           
           lda      SMURF+ResourceType  If rType is null it's multi
           beq      Setup
           
           lda      #0                  Otherwise it's single
           sta      deref
           sta      deref+2
           sta      MTcount             Zap private loop counter
           RTS                          Head home with z set
                      
Setup      lda      SMURF+EditResult    Set up out base record address
           sta      deref                 o
           lda      SMURF+EditResult+2    o
           sta      deref+2               o
           
           lda      [deref]             Get number of aliases
           sta      MTcount             Analagous to loop count
           
           stz      MTindex             Used for reference to EditResult2 table

           clc                          Plus 2 points deref at the 1st rType
           lda      deref                 o
           adc      #2                    o
           sta      deref                 o
           lda      deref+2
           adc      #0
           sta      deref+2
 
           lda      SMURF+EditResult2   Set up out base record menu address
           sta      deref2                o
           lda      SMURF+EditResult2+2   o
           sta      deref2+2              o
           ldy      #0

NextMulti  lda      MTcount             See if we're out of aliases
           beq      Done
           
           dec      MTcount             No... lop off another one
           
           lda      [deref]             deref->rType...
           sta      SMURF+ResourceType  Setup SMURF like a single return
           
           clc                          Plus 2 points at the editor name
           lda      deref                 o
           adc      #2                    o
           sta      SMURF+EditResult      o
           lda      deref+2
           adc      #0
           sta      SMURF+EditResult+2
                           
           clc                          Plus 34 (above 2 not applied) points
           lda      deref               at the next rType
           adc      #34                   o
           sta      deref                 o
           lda      deref+2               o
           adc      #0
           sta      deref+2

           lda      ValidMenu
           beq      SkipMenu

           ldy      MTindex             Get the menu offset
           lda      [deref2],y          Copy pointer pointed to by deref
           sta      SMURF+EditResult2        into editresult2
           iny                            o
           iny                            o
           lda      [deref2],y            o
           sta      SMURF+EditResult2+2
           iny
           iny
           sty      MTindex             Save next index

SkipMenu   lda      #-1                 clz for return to top of loop in caller

Done       RTS

MTcount    ds       2
MTindex    ds       2
ValidMenu  ds       2

MenuAddr   ds       4

TempID     ds       2

Type       ds       2
Addr       ds       4
Root       ds       4
Temp       ds       4
MenuFlag   ds       2

OpenDir    dc       i'2,0',i4'EditDir'

FEntry     dc       i'13,0,0,1,1',i4'FEntBuf',i2'0'
FEntType   ds       28
FEntAuxT   ds       4

FEntBuf    dc       i1'32'
FEntName   ds       33

CloseDir   dc       i'1,0'

ExitStack  ds       2

UserBuf    dc       i2'508'             Class 1 output string
UserDir    ds       508                 Class 1 input string

           END

SortProc   START    M_WOLFGRAM
           phb                              bRTLaptrbptr
           phd                              dpbRTLaptrbptr
           phk
           plb
           pha
           pha                              ????dpbRTLaptrbptr
           tsc                                       111111111
           tcd                           dp:123456789012345678

           lda      [11]                Dereference pointer to menuitem_A
           sta      1                     o
           ldy      #2                    o
           lda      [11],y                o
           sta      3

           ldy      #10                 Dereference pointer to menutext_A
           lda      [1],y                 o
           sta      11                    o
           iny                            o
           iny
           lda      [1],y
           sta      13

           lda      11                  Move pointer_A into DP/Stack loc 1
           sta      1                     o
           lda      13                    o
           sta      3                     o

           lda      [15]                Dereference pointer to menuitem_B
           sta      11                    o
           ldy      #2                    o
           lda      [15],y                o
           sta      13

           ldy      #10                 Dereference pointer to menutext_B
           lda      [11],y                o
           sta      15                    o
           iny                            o
           iny
           lda      [11],y
           sta      17

           lda      5                   Move frame junk out of our way
           sta      13                    o
           lda      7                     o
           sta      11                    o

           lda      15                  Move pointer_B into DP/Stack loc 5
           sta      5                     o
           lda      17                    o
           sta      7                     o

           lda      9                   Finish frame manipulation
           sta      17                    o
           lda      11                    o
           sta      15                      astrbstr----dpbRTL

           jsl      pstrcmp                 ----dpbRTL
           ply                              --dpbRTL
           ply                              dpbRTL
           pld                              bRTL
           plb                              RTL

           RTL

           END
