; ; File: ScriptMgrExtensions.a ; ; Contains: Extensions to the Script Manager that were formerly in ScriptMgrExtTail.a. ; ; Written by: FM Fred Monroe ; JSM Jeff Miller ; PKE Peter Edberg ; HA Hani Abdelazim ; ; Copyright: © 1992-1993 by Apple Computer, Inc. All rights reserved. ; ; Change History (most recent first): ; ; 5/21/93 CSS Update fixes from Reality per P. Edberg's review: ; <12> 4/2/93 ngk Fix bug with gestalt routine. It was returning a long instead of ; a short. This is bad with Pascal calling conventions. ; 11/19/92 RB When looking for the standard Chicago font, look in ROM first. ; 11/6/92 SWC Changed PackMacs.a->Packages.a. ; 10/27/92 CSS Changed short branch to word branch. ; <10> 7/6/92 HA ##1034403 : Fixed bug in StyledLineBreak, now I made sure ; to return the correct offset when the (text buffer ends with a ; carriage return) AND (textStart parameter is > 0 ) AND the whole ; text fits in the line pixel width) . ; <9> 6/22/92 PKE #1032408 : <+ csd>: Move check for presence of bidi & ; 2-byte scripts to be after call to ScriptAvail vector. ; <8> 6/17/92 HA #1029756,: #1032724 : Fixed CharType to return correct ; results when offset is > 256. #1029756 moved here the new ; StyledLineBreak (and FindCarriage) from ScriptMgrUtilText.a, so ; the new routine will be included in ptch 27. ; <7> 6/5/92 PKE #1031797 : Add option-space to prevent enabling of all ; scripts except primary & roman ; <6> 5/31/92 FM Add entry point StdExit for call by the ROM build. There was a ; duplicate of this code in another file. The only difference was ; this added label. ; <5> 5/18/92 PKE #1028382,: InitScripts should not enable a script if it has ; no fonts. If the specified system font is not present but other ; fonts in the script range are, use one of them. ; <4> 5/14/92 PKE #1029395,: Move glue for generic FindScriptRun from Roman ; script to Script Mgr dispatcher so scripts get it for free; we ; only come to romanFindScriptRun if a new-format table does not ; exist. Move new FindScriptTable record to ScriptPriv.a, where it ; belongs. ; <3> 5/8/92 PKE #1029395,: Fix FindScriptRun for non-Roman simple scripts ; to handle "shared" characters (space, punctuation) contextually. ; Also fix it to get the correct itl2. ; <2> 4/28/92 JSM Move almost all resident code from ScriptMgrExtTail.a here. ; Slightly modified the LwrString routine by changing the name of ; the entry point to NewLwrString so we could keep the weird ; come-from patch back in ScriptMgrExtTail.a where it belongs. ; This file has no conditionals (yay!). ; <1> 4/28/92 JSM first checked in ; blanks on string asis LOAD 'StandardEqu.d' include 'ScriptPriv.a' include 'Packages.a' include 'IntlUtilsPriv.a' include 'GestaltEqu.a' ; ----------------------------------------------------------------------- <1.4> ; Gestalt function ; proc import StdUnlink export gestaltScriptMgr,gestaltSMgrTable ;____________________________________________________________ ; The following Gestalt Function is an interface between the Gestalt mechanism ; and the Script Manager's GetEnvirons routine. Currently, it only supports two ; Gestalt selectors: gestaltScriptMgrVersion and gestaltScriptCount. ; ; Routine gestaltScriptMgr ( ; gestaltSelector: OSType; = PACKED ARRAY [1..4] OF CHAR; ; VAR gestaltResult: Longint; ; ): OSErr; = Integer; ; ; <08/05/89 pke> New today ;____________________________________________________________ gestaltSMgrFrame record {oldA6},decrement result ds.w 1 ; OSErr argSize equ *-8 gestaltSelector ds.l 1 ; packed array [1..4] of char gestaltResult ds.l 1 ; addr of longint result return ds.l 1 oldA6 ds.l 1 localFrame equ * endR ;____________________________________________________________ gestaltScriptMgr with gestaltSMgrFrame link a6,#localFrame ; initialize loop, set up default return values move.l gestaltSelector(a6),d0 ; selector value move.w #gestaltUndefSelectorErr,result(a6) ; assume unknown selector <12> lea gestaltSMgrTable,a1 ; loop to find Gestalt selector in table @gestaltLoop move.l (a1)+,d1 ; get next table entry beq.s @gestaltDone ; end of list, quit move.w (a1)+,d2 ; now get GetEnvirons verb cmp.l d0,d1 ; is selector correct? bne.s @gestaltLoop ; no, get next one ; ok, we found the Gestalt selector. Now call GetEnvirons with correct verb clr.l -(sp) ; space for result move.w d2,-(sp) ; push verb _GetEnvirons move.l gestaltResult(a6),a0 ; addr for result move.l (sp)+,(a0) ; pop result into Gestalt move.w #noErr,result(a6) ; return no error ; all done @gestaltDone move.w #argSize, d0 ; for StdUnlink bra StdUnlink ; standard exit endWith ; Table for converting between gestalt selectors and GetEnvirons verbs. Each pair ; consists of a long with the gestalt selector, followed by a word with the ; GetEnvirons verb. This table and the equate files where the Gestalt selectors ; are defined are the only things that need to change to add new Gestalt selectors ; for the Script Manager. gestaltSMgrTable dc.l gestaltScriptMgrVersion dc.w smVersion dc.l gestaltScriptCount dc.w smEnabled dc.l 0 ; terminator endproc ; ---------------------------------------------------------------------------- <45> ; function: PrintAction ; input: d0.l Printer GrafPort. ; d1.w Printer number. ; warning: This routine is register based. ; ; The script manager print action routine calls the print action routines ; of each script that is currently installed. These private print action ; routines should preserve all of the registers. ; ---------------------------------------------------------------------------- proc export PrintAction ; Save the registers and load a pointer to the list of script entries in the ; script manager globals. Load the script manager count so we will step ; through all of the scripts. ; ; register usage: ; a4.l Script Manager globals, script entry table. ; a3.l Script Interface System entry pointer. ; d4.l Count of script entries. PrintAction with smgrRecord,scriptRecord ; movem.l a0-a6/d0-d7,-(sp) ; save all registers. GetSMgrCore a4 ; load SMgr pointer. lea smgrEntry(a4),a4 ; load entry table address. move.w #smgrCount,d4 ; get the count. bra.s @2 ; enter loop at bottom. ; Check the next script system to see if it is installed. If so, load call ; the printer action routine. A pointer to the routine is kept in the ; script entry record. @1 move.l (a4)+,d3 ; entry pointer = nil? beq.s @2 ; yes -> try the next script. move.l d3,a3 ; load entry pointer. tst.b scriptEnabled(a3) ; script disabled? beq.s @2 ; yes -> try the next script. move.l scriptPrint(a3),d3 ; action pointer = nil? beq.s @2 ; yes -> try the next script. move.l a3,a0 ; pass ScriptRecord pointer to script <45> move.l d3,a3 ; load action pointer. movem.l a4/d0-d4,-(sp) ; save used registers. jsr (a3) ; call the routine. movem.l (sp)+,a4/d0-d4 ; restore used registers. @2 dbra d4,@1 ; try the next one. ; Restore the registers and return to the caller. movem.l (sp)+,a0-a6/d0-d7 ; restore all registers. rts ; return to the caller. endwith ;smgrRecord,scriptRecord endproc ; ---------------------------------------------------------------------------- <8> ; Function FindScriptRun ( ; textPtr: Ptr; ; textLen: Longint; ; var lenUsed: Longint ; ): Integer; ; ; Find a block of text. Very simple for Roman! ; Modified to use itl2 tables for simple scripts (single-byte,non-Roman) ; ---------------------------------------------------------------------------- proc export FindScriptRun FScript record {oldA6},decr Result ds.w 1 ; result of the function ParamStart equ * TextPtr ds.l 1 ; Pointer Length ds.l 1 ; length of the text LenUsedPtr ds.l 1 ; Length use scriptRecPtr ds.l 1 ; Scriptrecord ptr ParamEnd equ * Return ds.l 1 ; oldA6 ds.l 1 FScriptFrame equ * endr FindScriptRun WITH ScriptRecord,FScript ; <3> link a6,#FScriptFrame ; now link always <3> clr.w Result(a6) ; initialize to script Roman, variant zero <3> move.l Length(a6),d1 ; check length <3> bpl.s @goodLength ; if negative, <3> moveq #0,d1 ; fix it <3> @goodLength move.l LenUsedPtr(a6),a0 ; LenUsedPtr is the address <3> move.l d1,(a0) ; initialize lenUsed to textLen <3> move.l scriptRecPtr(a6),a0 ; get script pointer <3> moveq #0,d0 ; for word-izing <3> move.b scriptID(a0),d0 ; what script are we really handling? <3> beq @doneRoman ; if Roman, done, go unlink & return <3> move.b d0,Result(a6) ; initialize to real script, variant 0 <3> tst.l d1 ; any length? <3> beq @doneRoman ; if not, bail now <3> ; Now use GetScriptItl <3> subq #4,sp ; make room for the itl handle. move.w #2,-(sp) ; push 'which' argument => itl2. move.w d0,-(sp) ; push ScriptCode move.w #-1,-(sp) ; push sysFlag as TRUE _IUGetScriptItl ; get itl handle move.l (sp)+,d0 ; pop handle (null if err) beq.s @doneRoman ; bail if none move.l d0,a1 ; get handle move.l (a1),a1 ; get pointer move.w findScriptTableOffset(a1),d0 ; get offset to table beq.s @doneRoman ; bail if no table tst.w findScriptTableLen(a1) ; check table length beq.s @doneRoman ; bail if null add.w d0,a1 ; make pointer to table ; Now we assume old format; new format would have been picked up by glue in <4> ; Script Mgr dispatcher. @oldFormat move.l a2,-(sp) ; <3> move.l Length(a6),d0 ; text length to d0 move.l a1,a2 ; working table ptr in a1, saved in a2 <31++><3> move.l TextPtr(a6),a0 ; text pointer to a0 move.b (a0)+,d1 ; get character bra.s @JmpIn1 ; get initial script! @InitScriptLoop addq #1,a1 @JmpIn1 cmp.b (a1)+,d1 bhi.s @InitScriptLoop ; not in this script range <31> move.b (a1),d2 ; save initial script of this text move.b d2,result(a6) ; and return it to caller in hi byte of word ; sub 1 to zero base for the dbne below ; a2 = ptr to FindScriptTable ; a0 = textPtr ; d0.l = textLen ; d2 = script of the first byte of the textPtr ; now search for script run boundary @TextLoop sub.l #1,d0 ; update textLen beyond processed char <31+> beq.s @noMoreText ; <31+> move.l a2,a1 ; reset ptr to FindScriptTable <31++> move.b (a0)+,d1 ; get character bra.s @JmpIn2 @RangeLoop addq #1,a1 @JmpIn2 cmp.b (a1)+,d1 ; cmp to char range & incr to script # bhi.s @RangeLoop ; not in this script range <31> ; found range of character cmp.b (a1),d2 ; are the scripts the same <31+> beq.s @TextLoop ; yep, so branch (can't use dbne since d0 is long) <31+> @noMoreText ; found a script boundary move.l LenUsedPtr(a6),a0 ; LenUsedPtr is the address sub.l d0,(a0) ; contains initial length @done move.l (sp)+,a2 ; <3> @doneRoman unlk a6 move.l (sp)+,a1 ; get return address add.w #ParamStart-ParamEnd,sp ; remove parameters from stack jmp (a1) ; return endwith ;ScriptRecord,FScript endproc ; ---------------------------------------------------------------------------- <18> ; function: ParseTable(tablePtr: Ptr): Boolean; ; input: (sp).l Pointer to parse table. ; output: (sp).w Table validity flag. ; warning: This routine follows pascal register conventions. ; ; ParseTable fills the given table with values for parsing characters in the ; Roman script. ; ---------------------------------------------------------------------------- proc ; <18> export ParseTable ; <18> import StdUnlink ; <18> ptRecord record {oldA6},decr result ds.w 1 ; validity flag. ptArgs equ *-8 ; size of args. BUG FIX: Moved this AFTER result. <18> table ds.l 1 ; parse table pointer. selector ds.l 1 ; selector return ds.l 1 ; return address. oldA6 ds.l 1 ; old link address. ptLocals equ * ; size of local variables. endr ; Link the stack and set the result to true. Since Roman characters are all ; one byte long, all we have to do is clear the parse table. ParseTable with ptRecord link a6,#ptLocals ; set up stack frame. move.w #$0100,result(a6) ; set result to true. move.l table(a6),a0 ; load table pointer. move.w #256-1,d0 ; load table length - 1. @0 clr.b (a0)+ ; clear a byte in the table. dbra d0,@0 ; do the next entry. ; Unlink the stack and return to the caller. move.w #ptArgs,d0 ; for std exit bra StdUnlink ; StdUnlink endWith endproc ; <18> ;------------------------------------------------------------------------ <14> ; FUNCTION InitScripts: OSErr; ;------------------------------------------------------------------------ ; ; InitScripts routine calls FixSMgrWorld and then handles new ; initializations that must be done after script systems are installed ; and enabled. ; ; These initializations set up the emItlSysCache sort cache (with entries <15> ; for each script in correct sorting order), and the emScriptMap and ; emLangMap tables that map script (lang) to sorting position and default ; lang (script). ; ; KillOldFixWorldVec is just an rts whose address we can stuff in the ; old sVectFixSMgrWorld vector to render it inactive. ; proc export InitScripts, KillOldFixWorldVec import StdUnlink disabCacheReq equ -2 ; disable cache request in CurFMInput <26> isFrame record {a6link},decr result ds.w 1 ; OSErr result code. isArgs equ *-8 ; size of arguments. selector ds.l 1 ; selector return ds.l 1 ; return address. a6link ds.l 1 ; old a6 saveItlcSysFlag ds.w 1 ; save sysflags from itlc <7> saveOldISOkeybd ds.b 1 ; Mac Plus ISO keybd flag <7> disabAuxScripts ds.b 1 ; T to enable only system & Roman script <7> isLocals equ * endr isRegs reg d3-d7/a2-a4 ; save all regs InitScripts with SMgrRecord,isFrame,ExpandMemRec ; link a6,#isLocals ; link the stack. movem.l isRegs,-(sp) ; save regs ; ---------------------------------------------------------------------------- <26> ; The first batch of stuff is mostly a copy of the old FixSMgrWorld routine, ; enhanced to (1) get the RegionCode from itlc, (2) copy and check the extended ; itlb font and style info if present. It no longer detaches the itlc. ; ---------------------------------------------------------------------------- FixSMgrWorld with smgrRecord ; GetSmgrCore a4 ; get script manager core. ; Install the keyboard swapping table from the system file. If we get a nil ; handle back, we store the nil value in the script manager globals anyway. ; This effectively disables keyboard swapping. sub.l #4,sp ; make room for handle. move.l #'KSWP',-(sp) ; push KSWP type. move.w #0,-(sp) ; push KSWP id number. _GetResource ; get the KSWP resource. move.l (sp)+,smgrKeySwap(a4) ; store handle in SMgr globals. ; Load the configuration resource and set the system and ; keyboard script numbers in the script manager globals. ; Moved this after enabling all installed scripts. <37> ; Moved back here <7> ; Currently we don't touch the following fields in SMgrRecord, which ; are set from itlc only in ScriptMgrInit.a; should we reset them here? ; smgrFontForce from itlcFontForce ; smgrIntlForce from itlcIntlForce ; smgrGenFlags from itlcFlags high byte clr.w saveItlcSysFlag(a6) ; set to 0 if we can't get 'itlc' <7> clr.b saveOldISOkeybd(a6) ; set to 0 if we can't get 'itlc' <7> with itlcRecord sub.w #4,sp ; make room for handle. move.l #'itlc',-(sp) ; push conf type. move.w #0,-(sp) ; push conf number. _GetResource ; load the resource. move.l (sp)+,d0 ; handle = nil? beq.s @doneItlc ; yes -> skip this. move.l d0,a0 ; load conf handle. move.l (a0),a0 ; load conf pointer. move.w itlcSystem(a0),d1 ; load system code. move.w d1,smgrSysScript(a4) ; set system script. move.w d1,smgrKeyScript(a4) ; set key script. move.w itlcRegionCode(a0),d1 ; get preferred region code. <26> move.w d1,smgrRegionCode(a4) ; save in globals <26> move.w itlcSysFlags(a0),saveItlcSysFlag(a6) ; save system flags <7> move.b itlcOldKybd(a0),saveOldISOkeybd(a6) ; save Mac Plus ISO flag <7> endWith ;itlcRecord @doneItlc ; Check for Option-space to prevent enabling of scripts other than system <7> ; script & Roman ; Masks for word at KeyMap+6: ClearCapsLock equ $FFFD ; and with this to ignore CapsLock <7> NormalOptSpace equ $0204 ; bits set for Opt & Space on reg kybd <7> MacPlusISOOptSp equ $1004 ; bits set for Opt & Space on Mac+ ISO <7> move.w KeyMap+6,d0 ; get state of modifiers, space, etc <7> and.w #ClearCapsLock,d0 ; ignore Caps Lock <7> move.w #NormalOptSpace,d1 ; setup desired bit state <7> cmp.b #3,KbdType ; is it a 128K/512K-type mini keyboard? <7> bne.s @doCompare ; if not, we're ready to check bits <7> tst.b saveOldISOkeybd(a6) ; is it the ISO version? <7> beq.s @doCompare ; if not, we're ready to check bits <7> move.w #MacPlusISOOptSp,d1 ; else desired bit state is different <7> @doCompare ; <7> cmp.w d1,d0 ; Do we have Opt-Space & nothing else? <7> seq disabAuxScripts(a6) ; if so, set disable flag <7> ; Fetch the script bundle for each installed script and copy the bundle ; information into the script entry. If we cannot find a bundle for a ; script, it is disabled. Notice that at least one bundle must be found ; for an installed script in order for the script manager to be enabled. with ScriptRecord sf smgrEnabled(a4) ; clear the enabled counter. move.w #smgrCount-1,d3 ; forall entries. @scriptLoop move.w d3,d0 ; copy index. lsl.w #2,d0 ; long word offset. move.l smgrEntry(a4,d0.w),d0 ; script installed? beq @nextScript ; no -> try next entry. move.l d0,a3 ; load script entry. sf scriptEnabled(a3) ; disable this entry. ; check for disabling key combo <7> tst.w d3 ; is it Roman? <7> beq.s @dontDisable ; if so, don't disable <7> cmp.w smgrSysScript(a4),d3 ; is it system? <7> beq.s @dontDisable ; if so, don't disable <7> tst.b disabAuxScripts(a6) ; are we disabling others? <7> bne @nextScript ; if so, we're outta here <7> @dontDisable sub.l #4,sp ; make room for handle. move.l #'itlb',-(sp) ; push bundle type. move.w d3,-(sp) ; push bundle number. _GetResource ; load the resource. move.l (sp)+,d0 ; handle = nil? beq @nextScript ; yes -> try next entry. with ItlbRecord move.l d0,a2 ; load bundle handle. move.l (a2),a0 ; load bundle pointer. lea scriptBundle(a3),a1 ; load script pointer. move.l #itlbSize,d0 ; load size of bundle. _BlockMove ; copy bundle into script. endwith ;ItlbRecord move.b d3,scriptID(a3) ; put script code in ScriptRecord <52> ; Now see if we have an extended bundle, and if so, copy font info <26> with ItlbExtRecord subq #4,sp ; space for SizeRsrc result move.l a2,-(sp) ; push 'itlb' handle _SizeRsrc cmp.l #itlbExtSize,(sp)+ ; is itlb size big enough blt @doneExtItlb ; skip if too small or res err move.l (a2),a0 ; get itlb pointer move.l itlbMonoFond(a0),scriptMonoFondSize(a3) ; set the mono font. move.l itlbPrefFond(a0),scriptPrefFondSize(a3) ; set the font. move.l itlbSmallFond(a0),scriptSmallFondSize(a3) ; set the font. move.l itlbSysFond(a0),scriptSysFondSize(a3) ; set the font. move.l itlbAppFond(a0),scriptAppFondSize(a3) ; set the font. move.l itlbHelpFond(a0),scriptHelpFondSize(a3) ; set the font. move.b itlbValidStyles(a0),scriptValidStyles(a3) ; set valid styles move.b itlbAliasStyle(a0),scriptAliasStyle(a3) ; set alias style endwith ;ItlbExtRecord ; Done with bundle, now do some checking. <26> ; First, if this is Roman, do some funky testing for sys fond ID. ; If Chicago $3FFF is present, it becomes the Roman sys font. ; If not, try the itlb value. If this also isn't present, assume ; 0 is the Roman sys FOND ID. clr.b ResLoad ; don't bother loading fonts (move here) <5> tst.w d3 ; is this Roman? bne.s @nonRoman ; if not, different check <5> move.w #RomanSysFond,d4 ; assume fond $3FFF exists bsr.s @returnIfNotFound ; set if found, return if not <5> move.w scriptSysFondSize(a3),d4 ; try itlb value <5> bsr.s @returnIfNotFound ; set if found, return if not <5> clr.w d4 ; otherwise, reset to 0 bra.s @setSysFondId ; <5> @nonRoman ; check that itlb system font ID is there <5> move.w scriptSysFondSize(a3),d4 ; try itlb value bsr.s @returnIfNotFound ; set if found, return if not ; if not, try itlb app font ID <5> move.w scriptAppFondSize(a3),d4 ; try itlb value bsr.s @returnIfNotFound ; set if found, return if not ; specified font not there; use first font in range <5> subq #4,sp ; space for result move.w d3,-(sp) ; push ScriptCode (explicit code works at this point in boot) _ScriptToRange ; map it move.l (sp)+,d4 ; min in high word, max in low move.w d4,d5 swap d4 ; min in d4.w, max in d5.w @fontLoop bsr.s @returnIfNotFound ; set if found, return if not addq.w #1,d4 cmp.w d5,d4 ; past end of range? ble.s @fontLoop ; if not, check next bra.s @nextScript ; else no fonts found, don't enable ; this routine expects FOND ID in d4. If found, it pops return addr and <5> ; falls through to set system font to the value in d4. Otherwise, it ; returns to the caller. @returnIfNotFound subq #4,sp ; space for return value move.l #'FOND',-(sp) ; push type move.w d4,-(sp) ; push next id in range MOVE.W #MapTrue,RomMapInsert ; look in ROM first rb _GetResource tst.l (sp)+ ; was it there? bne.s @popRetnAndSetSysFondId ; if yes, go reset rts @popRetnAndSetSysFondId addq #4,sp ; discard return addr @setSysFondId ; <5> move.w d4,scriptSysFondSize(a3) ; reset the system font. <5> ; now check non-sys fonts and copy font IDs to old fields <26> move.w scriptSysFondSize(a3),scriptSysFond(a3) ; copy sys fond to old field lea scriptAppFondSize(a3),a0 bsr FixFond ; resets to sys fond if bad move.w scriptAppFondSize(a3),scriptAppFond(a3) ; copy app fond to old field lea scriptMonoFondSize(a3),a0 ; top word is fond id bsr FixFond ; resets to sys fond if bad lea scriptPrefFondSize(a3),a0 ; top word is fond id bsr FixFond ; resets to sys fond if bad lea scriptSmallFondSize(a3),a0 ; top word is fond id bsr FixFond ; resets to sys fond if bad lea scriptHelpFondSize(a3),a0 ; top word is fond id bsr FixFond ; resets to sys fond if bad @doneExtItlb st scriptEnabled(a3) ; enable this entry. add.b #1,smgrEnabled(a4) ; enable the script manager. ; moved scriptRedraw check down after call to ScriptAvail <9> @nextScript move.b #1,ResLoad ; reset ResLoad (move here) <5> dbra d3,@scriptLoop ; do the next entry. endWith ;ScriptRecord ; (Load the configuration resource and set the system and ; keyboard script numbers in the script manager globals.) ; Moved this here from above, so we can make decisions based on <37> ; enabled scripts. <37> ; Moved back above to get keyboard flag earlier, but keep decisions <7> ; here. ; moveq #0,d0 ; assume L->R <37> tst.w saveItlcSysFlag(a6) ; check system flags <37><7> bpl.s @doneSysFlags ; if config is L->R, don't change <37> cmpi.w #1,smgrEnabled(a4) ; how many scripts? <37> ble.s @doneSysFlags ; if Roman only, don't change <37> moveq #-1,d0 ; else R->L <37> @doneSysFlags ; <37> move.w d0,TESysJust ; set direction <37> ; If the current system script is not installed, or is installed but not ; enabled, default the system and key scripts to Roman. with scriptRecord move.w smgrSysScript(a4),d3 ; load system script code. move.w d3,d0 ; copy system script code. lsl.w #2,d0 ; code is long word index. move.l smgrEntry(a4,d0.w),d0 ; system script installed? beq.s @useRoman ; no -> use Roman. move.l d0,a3 ; load system script entry. tst.b scriptEnabled(a3) ; system script enabled? bne.s @doneCheckSysScript ; yes -> keep system script. @useRoman move.l #smRoman,d3 ; script is Roman. move.l smgrEntry(a4),a3 ; load Roman script entry. move.w d3,smgrSysScript(a4) ; reset system script. move.w d3,smgrKeyScript(a4) ; reset keyboard script. endWith ;scriptRecord @doneCheckSysScript ; Set the system font according to the system script. If the application ; font is not in the system script's range, then reset it as well. ; Note that we expect the system script code in d3 and its entry in a3. ; Also, we have SMgrRecord pointer in a4. with scriptRecord ; Now we just set it ; <41> move.w scriptSysFond(a3),d0 ; get desired system font. <41> cmp.w SysFontFam,d0 ; already set up? <41> beq.s @SkipSFontSet ; yes -> skip resetting. <41> move.w d0,SysFontFam ; set desired system font. <41> move.w #disabCacheReq,CurFMInput ; disable cache request <41> @SkipSFontSet move.w scriptAppFond(a3),d0 ; get desired application font. <41> cmp.w ApFontID,d0 ; already set up? <41> beq.s @SkipAFontSet ; yes -> skip resetting. <41> move.w d0,ApFontID ; set desired application font. <41> move.w #disabCacheReq,CurFMInput ; disable cache request <41> @SkipAFontSet ; Load the keyboard character table for the new system script. If this fails, ; we are left with the current KCHR resource in the cache. move.w smgrKeyScript(a4),-(sp) ; push current keyboard script. <16jun87 jdt> _KeyScript ; load appropriate KCHR. <16jun87 jdt> ; Save the new boot driver number. This prevents us from executing all of ; the above code during a vanilla-launch. move.w BootDrive,smgrSysRef(a4) ; save vRefNum in globals. endWith ; ScriptRecord endWith ; SMgrRecord ; EndFixSMgrWorld ; ---------------------------------------------------------------------------- ; Set up regs we'll need move.l IntlSpec,a3 ; SMgrRecord ptr move.l ExpandMem,a4 ; ExpandMemRec ptr ; Initialize ItlSysCache with NewItlCacheRec moveq #0,d0 ; for wordizing smgrEnabled move.b smgrEnabled(a3),d0 ; how many scripts installed? move.w d0,d3 ; save copy mulu.w #newItlCacheRecSize,d0 ; one record per script addq.l #2,d0 ; space for record count _NewPtr sys,clear ; make a0 point to new space bne @doneInitScripts ; bail if error (errcode in d0) move.l a0,emItlSysCachePtr(a4) ; save pointer move.w d3,(a0)+ ; put in record count move.l a0,a2 ; save for later use endwith ;NewItlCacheRec ; Get 'itlm' resource subq #4,sp ; space for returned handle move.l #'itlm',-(sp) ; resource type clr.w -(sp) ; resource ID _GetResource move.l (sp)+,d7 ; check handle, save in d7 beq @resError ; special handling for rmgr errs move.l d7,a0 ; copy handle move.l (a0),d6 ; dereference, save in d6 _HLock ; "can't have error here" ; Next, put script codes in emItlSysCache in proper sort order with ItlmHeaderRec,ScriptRecord,NewItlCacheRec move.l d6,a1 ; copy pointer add.l scriptDataOffset(a1),a1 ; point to scriptData table addq #4,a1 ; skip to num entries move.w (a1)+,d3 ; get num entries in 'itlm' table ; have emItlSysCachePtr in a2 from above move.w smgrSysScript(a3),d2 ; get system script move.w d2,(a2) ; system script always comes first lsl.w #2,d2 ; make it a long offset move.l smgrEntry(a3,d2.w),a0 ; get scriptRecord ptr for sys script st scriptInItlm(a0) ; remember that script has 'itlm' entry bra.s @nextEntry ; test for d3=0, decrement it for dbra @sysCacheLoop move.w (a1)+,d2 ; get next script code in 'itlm' addq #2,a1 ; skip default lang value cmp.w smgrSysScript(a3),d2 ; is it system script? beq.s @nextEntry ; if so, we handled it above move.w d2,d1 ; copy for shift lsl.w #2,d1 ; make a long offset move.l smgrEntry(a3,d1.w),d0 ; get scriptRecord ptr beq.s @nextEntry ; if none, script not installed move.l d0,a0 tst.b scriptEnabled(a0) ; is script enabled? beq.s @nextEntry ; if not, really give up. st scriptInItlm(a0) ; remember that script has 'itlm' entry add.w #newItlCacheRecSize,a2 ; now go to next emItlSysCache entry move.w d2,(a2) ; put script code in emItlSysCache entry @nextEntry dbra d3,@sysCacheLoop ; Now, go through installed & enabled scripts and add any that were not in 'itlm'. move.w #smgrCount-1,d3 ; for all possible scriptsÉ moveq #0,d2 ; current script move.w #0,d4 ; keep track of max script code forÉ ; Éinst. & enab. scripts lea smgrEntry(a3),a1 ; pointer to current entry in SMgrRecord @scriptLoop move.l (a1)+,d0 ; get scriptRecord ptr beq.s @nextScript ; if none, script not installed move.l d0,a0 tst.b scriptEnabled(a0) ; is script enabled? beq.s @nextScript ; if not, really give up. move.w d2,d4 ; keep max inst & enab script code so far tst.b scriptInItlm(a0) ; have we already put this in emItlSysCache? bne.s @nextScript ; skip if so add.w #newItlCacheRecSize,a2 ; otherwise go to next emItlSysCache entry move.w d2,(a2) ; put script code in emItlSysCache entry @nextScript addq.w #1,d2 ; next script dbra d3,@scriptLoop endwith ;ItlmHeaderRec,ScriptRecord,NewItlCacheRec ; Now emItlSysCache is set up, and d4 has max script code for an installed & enabled ; script. ; Next, allocate space for scriptData and fill it header entries with ItlmHeaderRec,NewItlCacheRec move.l d6,a1 ; copy pointer add.l scriptDataOffset(a1),a1 ; point to scriptData table move.w (a1)+,d5 ; get max script for table cmp.w d4,d5 ; is it big enough? bge.s @bigEnough ; if so, ok so far move.w d4,d5 ; if not, make it big enough @bigEnough lea emScriptMapPtr(a4),a2 ; say where to save ptr ; Allocate map table, put pointer in ExpandMem, copy header from itlm, ; advance pointer, set some registers with values from header, and fill in ; default values. ; ; Scripts with real entries will replace the default values. Scripts that ; are not installed and enabled are sorted after everything else in order ; of script number, by adding a base value to their script code. They get ; the default lang code. bsr SetHdrAndDefaults bne @unlockThenDone ; bail if can't allocate space ; Now fill in sort positions obtained from sort order in emItlSysCache moveq #0,d2 ; sort position count move.l emItlSysCachePtr(a4),a0 ; get emItlSysCache ptr move.w (a0)+,d3 ; get count of enab scripts bra.s @nextSort @sortLoop move.w (a0),d1 ; get next script code, in order lsl.w #2,d1 ; make a long offset move.w d2,0(a2,d1.w) ; set data in table addq.w #1,d2 ; next sort position add.w #newItlCacheRecSize,a0 ; now go to next emItlSysCache entry @nextSort dbra d3,@sortLoop ; And fill in lang codes obtained from 'itlm'. bra.s @nextScriptLang @scriptLangLoop move.w (a1)+,d1 ; get script code move.w (a1)+,d2 ; get lang code cmp.w d5,d1 ; too big? bgt.s @nextScriptLang ; skip if so lsl.w #2,d1 ; make a long offset move.w d2,2(a2,d1.w) ; stuff lang code @nextScriptLang dbra d4,@scriptLangLoop endwith ;ItlmHeaderRec,NewItlCacheRec ; Almost done: allocate space for langData and fill in header info. with ItlmHeaderRec move.l d6,a1 ; copy pointer add.l langDataOffset(a1),a1 ; point to langData table move.w (a1)+,d5 ; get max lang for table lea emLangMapPtr(a4),a2 ; say where to save ptr ; Allocate map table, put pointer in ExpandMem, copy header from itlm, ; advance pointer, set some registers with values from header, and fill in ; default values. ; ; Langs with real entries will replace the default values. Langs that ; are not in 'itlm' are sorted after everything else in order of lang ; code, by adding a base value to their lang code. They get the default ; script code. bsr SetHdrAndDefaults bne @unlockThenDone ; bail if can't allocate space ; Now just fill in sort positions obtained from 'itlm'. This is much ; simpler than what we did with script codes. moveq #0,d3 ; sort position bra.s @nextLang @langLoop move.l (a1)+,d2 ; get lang code & script swap d2 ; get lang code cmp.w d5,d2 ; too big? bgt.s @nextLang ; skip if so move.w d2,d1 lsl.w #2,d1 ; make a long offset move.w d3,d2 ; stuff sort position swap d2 ; put everything in its place move.l d2,(a2,d1.w) ; stuff lang code addq.w #1,d3 ; update sort position count @nextLang dbra d4,@langLoop endwith ;ItlmHeaderRec ; Now go through all installed & enabled scripts, loading the 'itl2' and <26> ; 'itl4' resource IDs & handles into the system itl cache, and calling the ; scriptÕs scriptAvail vector if non-zero. ; At this point, a4 still points to ExpandMemRec, a3 points to SMgrRecord. with ScriptRecord move.l emItlSysCachePtr(a4),a4 ; get emItlSysCache ptr move.w (a4)+,d7 ; number of enabled scripts bra.s @nextCopy ; dbra, so decrement d7 @copyLoop move.w (a4)+,d6 ; get script code move.w d6,d0 ; copy it lsl.w #2,d0 ; make it a long offset move.l smgrEntry(a3,d0.w),a2 ; and get scriptRecord ptr ; we already know script is enabled ;; sub #8,sp ; space for 2 GetResource results <55> with ItlbRecord move.w scriptBundle.itlbSort(a2),d0 ; get itl2 ID move.w d0,(a4)+ ; save ID in cache ;; move.l #'itl2',-(sp) ; push type <55> ;; move.w d0,-(sp) ; push ID <55> ;; _GetResource ; <55> ;; move.l (sp)+,(a4)+ ; save handle in cache (even if 0) <55> clr.l (a4)+ ; don't save a handle <55> move.w scriptBundle.itlbToken(a2),d0 ; get itl4 ID move.w d0,(a4)+ ; save ID in cache ;; move.l #'itl4',-(sp) ; push type <55> ;; move.w d0,-(sp) ; push ID <55> ;; _GetResource ; <55> ;; move.l (sp)+,(a4)+ ; save handle in cache (even if 0) <55> clr.l (a4)+ ; don't save a handle <55> endwith ;ItlbRecord ; now call ScriptAvail move.l scriptAvail(a2),d0 ; check script's Avail vector beq.s @checkRedraw ; if none, finish up this script <9> move.l d0,a0 ; otherwiseÉ move.w d6,-(sp) ; Épush script codeÉ jsr (a0) ; Éand call scriptÕs Avail routine ; Set smgrBidirect and smgrDoubleByte if appropriate (moved here from above) <37><9> @checkRedraw ; <9> tst.b scriptRedraw(a2) ; what kind of script is it? <37><9>* beq.s @doneCheckRedraw ; if redraw char, L->R 1-byte, done <37><9> bpl.s @setDouble ; if redraw word, 2-byte <37><9> st smgrBidirect(a3) ; else redraw line, bidi sys <37><9>* bra.s @doneCheckRedraw ; <37><9> @setDouble ; <37><9> st smgrDoubleByte(a3) ; <37><9>* @doneCheckRedraw ; <37><9> @nextCopy dbra d7,@copyLoop ; loop for all enabled scripts endwith ;ScriptRecord ; If we got to here, no errors moveq #0,d0 ; return noErr ; Set result and return @doneInitScripts move.w d0,result(a6) ; return error code or noErr movem.l (sp)+,isRegs ; restore regs move.w #isArgs,d0 ; for StdUnlink bra StdUnlink ; standard exit @resError move.w ResErr,d0 ; get current resource err code bne.s @doneInitScripts move.w #resNotFound,d0 ; some errs leave ResErr as 0 bra.s @doneInitScripts @unlockThenDone move.w d0,d6 ; save errcode across HUnlock move.l d7,a0 ; get handle _HUnlock move.w d6,d0 ; restore errcode bra.s @doneInitScripts endwith ;SMgrRecord,isFrame,ExpandMemRec ;-------- ; This utility routine allocates a block of memory for scriptMap or langMap, ; copies header information from the 'itlm' resource, fills in the table with ; default values, and sets up various registers. ; ; At entry: ; d5 max script or lang value for map table. WILL NOT BE CHANGED. ; a2 pointer to ExpandMemRec field for map table ptr. WILL BE REPLACED. ; a1 pointer to beginning of scriptData or langData table in 'itlm'. ; WILL BE ADVANCED PAST HEADER. ; ; At exit: ; d0 OSErr ; a1 pointer to scriptData or langdata data (past header). ; a2 pointer to map table data (past header, which has been filled in). ; d4 num entries in 'itlm' table ; ; Besides the above, uses: a0,d3,d2,d1 ;-------- SetHdrAndDefaults move.w d5,d0 addq.w #2,d0 ; add script 0 and header entry lsl.w #2,d0 ; get size (one long per entry) _NewPtr sys,clear ; OS trap, saves a1,d1-d2 bne.s @exit ; bail if error (errcode in d0) move.l a0,(a2) ; save ptr move.w (a1)+,d3 ; get default lang/script code move.w (a1)+,d4 ; get num entries in 'itlm' table move.w d5,(a0)+ move.w d3,(a0)+ move.l a0,a2 ; save pointer to data to fill in ; Fill in default values for everything. move.w d5,d2 clr.w d0 ; current script/lang code move.w #$1000,d1 ; base sort pos for bad scripts/langs @initLoop move.b d0,d1 ; make base + script/lang move.w d1,(a0)+ ; and put it in table move.w d3,(a0)+ ; put in default lang/script code addq.w #1,d0 ; next script/lang code dbra d2,@initLoop moveq #0,d0 ; no error @exit rts ; ----------------------------------------------------------------------------- ; Utility routine to check for FOND & reset if bad ; Input (a0): fond id ; a3: ptr to script globals <47> ; ; Don't manipulate ResLoad here, now done at higher level <5> ; ----------------------------------------------------------------------------- FixFond with ScriptRecord movem.l a2,-(sp) ; don't trash a2 <47> move.l a0,a2 ; remember pointer to fond id in a2 <47> subq #4,sp ; return room move.l #'FOND',-(sp) ; see if this FOND exists move.w (a2),-(sp) ; id, get the id from a2 pointer <47> MOVE.W #MapTrue,RomMapInsert ; look in ROM first rb _GetResource tst.l (sp)+ ; was it there? bne.s @fixFondDone ; yes, ok move.w scriptSysFond(a3),(a2) ; reset to system fond, changed to used a3 as pointer to script globals <47> @fixFondDone movem.l (sp)+,a2 ; restore a2 rts endwith ; ----------------------------------------------------------------------------- ; Convenient rts; this address will be stuffed in obsolete vectors KillOldFixWorldVec rts endproc ;------------------------------------------------------------------------ <32> ; FUNCTION ReInitScripts: OSErr; ;------------------------------------------------------------------------ ; ; ReInitScripts frees all of the structures set up by InitScripts, then ; redoes the parts of installation that must be performed with a new ; system file: setting fields from itlc, setting up a KCHR, and then ; calling InitScripts again. ; proc export ReInitScripts import StdUnlink risFrame record {a6link},decr result ds.w 1 ; OSErr result code. risArgs equ *-8 ; size of arguments. selector ds.l 1 ; selector return ds.l 1 ; return address. a6link ds.l 1 ; old a6 risLocals equ * endr risRegs reg d3-d7/a2-a4 ; save all regs ReInitScripts with risFrame,ExpandMemRec link a6,#risLocals ; link the stack. movem.l risRegs,-(sp) ; save regs ; dispose of caches whose size depended on resources in old system file move.l ExpandMem,a1 ; ExpandMemRec ptr moveq #0,d1 move.l emItlSysCachePtr(a1),a0 _DisposPtr move.l d1,emItlSysCachePtr(a1) move.l emScriptMapPtr(a1),a0 _DisposPtr move.l d1,emScriptMapPtr(a1) move.l emLangMapPtr(a1),a0 _DisposPtr move.l d1,emLangMapPtr(a1) ; Call _InitScripts and get any errors from it subq #2,sp ; make room for OSErr result _InitScripts ; move.w (sp)+,d0 ; get result in d0 ; Set result and return @doneReInitScripts move.w d0,result(a6) ; return error code or noErr movem.l (sp)+,risRegs ; restore regs move.w #risArgs,d0 ; for StdUnlink bra StdUnlink ; standard exit endwith ;risFrame,ExpandMemRec endproc ;------------------------------------------------------------------------ <16> ; FUNCTION AddScriptFonts: OSErr; ;------------------------------------------------------------------------ ; ; AddScriptFonts loops through all enabled script systems, checks the ; script's AddFonts vector, and calls the routine at that vector (if ; non-zero) to load additional fonts over the network (or do other ; post-initialization). ; proc export AddScriptFonts import StdUnlink asfFrame record {a6link},decr result ds.w 1 ; OSErr result code. asfArgs equ *-8 ; size of arguments. selector ds.l 1 ; selector return ds.l 1 ; return address. a6link ds.l 1 ; old a6 asfLocals equ * endr asRegs reg a2-a3/d3 ; regs to save AddScriptFonts with asfFrame,ExpandMemRec,NewItlCacheRec,SMgrRecord,ScriptRecord link a6,#asfLocals ; link the stack. movem.l asRegs,-(sp) ; save regs move.l IntlSpec,a3 ; GetSMgrRecord pointer move.l ExpandMem,a2 ; get ExpandMemRec ptr move.l emItlSysCachePtr(a2),a2 ; get sys itl cache ptr move.w (a2)+,d3 ; get count of enabled scripts bra.s @nextAddFont ; enter loop at end @addFontLoop move.w (a2)+,d1 ; get next script code add #newItlCacheRecSize-2,a2 ; advance to next cache entry move.w d1,d0 ; copy script code lsl.w #2,d0 ; make a long offset move.l smgrEntry(a3,d0.w),a0 ; get ScriptRecord ptr, know it's enabled move.l scriptAddFonts(a0),d0 ; check script's AddFonts vector beq.s @nextAddFont ; if none, skip to next script move.l d0,a0 ; otherwiseÉ move.w d1,-(sp) ; Épush script codeÉ jsr (a0) ; Éand call scriptÕs AddFonts routine @nextAddFont dbra d3,@addFontLoop move.w #noErr,result(a6) ; return noErr movem.l (sp)+,asRegs ; restore regs move.w #asfArgs,d0 ; for StdUnlink bra StdUnlink ; standard exit endwith ;asfFrame,ExpandMemRec,NewItlCacheRec,SMgrRecord,ScriptRecord endproc ;------------------------------------------------------------------------ <27> ; FUNCTION InitScriptApp: OSErr; ;------------------------------------------------------------------------ ; ; InitScriptApp initializes the application-specific Script Mgr globals, ; which are allocated in the app heap. ; So far, these just contain the application itl2/4 cache and some reserved ; fields. The code to initialize the cache was moved from InternationalPACK.a. ; proc export InitScriptApp import StdUnlink isaFrame record {a6link},decr result ds.w 1 ; OSErr result code. isaArgs equ *-8 ; size of arguments. selector ds.l 1 ; selector return ds.l 1 ; return address. a6link ds.l 1 ; old a6 isaLocals equ * endr isaRegs reg a2 ; regs to save InitScriptApp with isaFrame,ExpandMemRec,SMgrAppRecord link a6,#isaLocals ; link the stack. movem.l isaRegs,-(sp) ; save regs ; Create app-specific script globals, initialize itl cache part from ; sys itl cache. This code mostly moved from International PACK.a. move.l ExpandMem,a2 move.l emItlSysCachePtr(a2),a0 ; get pointer to sys itl cache _GetPtrSize tst.l d0 ; error? bmi.s @isaExit ; if so, no app script globals move.l d0,d2 ; save length add.l #smgrAppRsvdSize,d0 ; add space for other global fields _NewHandle ,CLEAR ; make global space in app heap <28> bmi.s @isaExit ; if error, no app script globals move.l a0,a1 ; save new handle in a1É move.l a1,emScriptAppGlobals(a2) ; Éand in ExpandMemRec field _HNoPurge ; and make it non-purgeable move.l emItlSysCachePtr(a2),a0 ; get pointer to sys itl cache move.l (a1),a1 ; get pointer to new globals lea smgrAppCacheCount(a1),a1 ; point to base of cache area move.l d2,d0 ; get length of cache part _BlockMove ; copy sys cache to app cache ; what to do about errors here? @isaExit move.w #noErr,result(a6) ; return noErr movem.l (sp)+,isaRegs ; restore regs move.w #isaArgs,d0 ; for StdUnlink bra StdUnlink ; standard exit endwith ;isaFrame,ExpandMemRec,SMgrAppRecord endproc ;------------------------------------------------------------------------ <27> ; FUNCTION CleanupScriptApp: OSErr; ;------------------------------------------------------------------------ ; ; CleanupScriptApp cleans up the application-specific Script Mgr globals. ; proc export CleanupScriptApp import StdUnlink csaFrame record {a6link},decr result ds.w 1 ; OSErr result code. csaArgs equ *-8 ; size of arguments. selector ds.l 1 ; selector return ds.l 1 ; return address. a6link ds.l 1 ; old a6 csaLocals equ * endr ;csaRegs reg a2-a3/d3 ; regs to save CleanupScriptApp with csaFrame,ExpandMemRec link a6,#csaLocals ; link the stack. ; movem.l csaRegs,-(sp) ; save regs ; If app script globals exist, dispose of them move.l ExpandMem,a0 ; get ptr to ExpandMemRec move.l emScriptAppGlobals(a0),a0 ; get handle to appÕs script globals move.l a0,d0 ; is it 0 (couldnÕt allocate)? beq.s @csaExit ; if so, nothing to do addq.l #1,d0 ; is it -1 (Process Mgr didnÕt set field)? beq.s @csaExit ; if so, nothing to do _DisposHandle move.l ExpandMem,a0 ; get ptr to ExpandMemRec <29> clr.l emScriptAppGlobals(a0) ; clear out so we don't try to use it <29> @csaExit move.w #noErr,result(a6) ; return noErr ; movem.l (sp)+,csaRegs ; restore regs move.w #csaArgs,d0 ; for StdUnlink bra StdUnlink ; standard exit endwith ;csaFrame,ExpandMemRec endproc ;------------------------------------------------------------------------------- <24> ; FUNCTION IsCmdChar(keyEvent: EventRecord; testChar: CHAR): BOOLEAN; ; ; This function tests if Command is being pressed in conjunction with another ; key (or keys) that could generate testChar for some combination of Command up ; or down and Shift up or down. This accomodates European keyboards that may ; have testChar as a Shifted character, and non-Roman keyboards that will ONLY ; generate testChar if Command is down. It is most useful for testing for ; Command-period. ; ; The caller passes in the event record, which is assumed by the function to be ; an event record for a key-down or auto-key event with the Command key down. ; The caller also passes in the character to be tested for (e.g. '.'). The ; function returns TRUE if the test char is produced with the current modifier ; keys, or if it would be produced by changing the current modifier key bits in ; the following ways: ; 1. turning the Command bit off ; 2. toggling the Shift bit ; 3. both of the above ;------------------------------------------------------------------------------- proc export IsCmdChar export DoKeyTrans ; <37> keyUpMask equ $80 ; or mask to set key up bit in keycode cmdOffMask equ $FEFF ; and mask to clear CmdKey bit in keycode cmdOnMask equ $0100 ; or mask to set CmdKey bit in keycode shiftToggleMask equ $0200 ; xor mask to toggle ShiftKey bit in keycode iccFrame record {a6link},decr result ds.w 1 ; Boolean result iccArgStart equ * eventRecPtr ds.l 1 ; Pointer to event record testChar ds.w 1 ; Char parameter to test for selector ds.l 1 ; Script Mgr selector iccArgEnd equ * return ds.l 1 ; return address a6link ds.l 1 ; link register iccLocals equ * iccArgSize equ iccArgStart-iccArgEnd endr iccRegs reg a2/d3-d4 ; regs to save <37> ; Local regs: ; a2.l KCHRPtr ; d3.w keycode ; d4.w testChar IsCmdChar with iccFrame LINK A6,#iccLocals ; movem.l iccRegs,-(sp) ; save regs <37> move.w testChar(a6),d4 ; save testChar <37> ;............................................................................... ; Set up KeyTrans parameters keycode and KCHRPtr ;............................................................................... move.l eventRecPtr(a6),a0 ; get ptr to event record move.w evtMeta(a0),d3 ; get modifier keys in hi byte of word <37> move.b evtMessage+2(a0),d3 ; get virtual key code in lo byte <37> or.b #keyUpMask,d3 ; Set key up bit. This will make <37> ; KeyTrans skip dead key processing. with ExpandMemRec MOVE.L ExpandMem,A0 ; Pointer to ExpandMemRec MOVE.L emKeyCache(A0),a2 ; Save pointer to KCHR resource <37> endwith ;............................................................................... ; Call KeyTrans with various modifier key settings ;............................................................................... ST result(A6) ; Assume we have a match BSR.S DoKeyTrans ; First, call with real modifiers BEQ.S DoneTest ; If that gave us a match, hooray AND.W #cmdOffMask,d3 ; Turn off Command and try again <37> BSR.S DoKeyTrans ; I can't stand the suspense BEQ.S DoneTest ; Do we have a match yet? MOVE.W #shiftToggleMask,D0 ; Because of weird 68000 EOR inst. EOR.W D0,d3 ; Toggle the Shift bit and try again <37> BSR.S DoKeyTrans ; Read all about itÉ BEQ.S DoneTest ; Are we home yet? OR.W #cmdOnMask,d3 ; Turn on Command and try once more <37> BSR.S DoKeyTrans ; Almost doneÉ SZ result(A6) ; Our final result ;............................................................................... ; Clean up and exit ;............................................................................... DoneTest movem.l (sp)+,iccRegs ; restore regs <37> UNLK A6 ; MOVE.L (SP)+,A0 ; pop return address ADD.L #iccArgSize,SP ; clean up parameter space JMP (A0) ; return to caller ;............................................................................... ; Subroutine for calling KeyTrans. Returns with condition codes set ; to indicate result: Z set if match, clear if no match. ; ; Assumes the following registers are set up: <37> ; a2.l KCHRPtr ; d3.w keycode ; d4.w testChar ;............................................................................... DoKeyTrans SUBQ.L #4, SP ; Make room for KeyTrans result MOVE.L a2,-(SP) ; Push pointer to KCHR resource <37> MOVE.W d3,-(SP) ; Push keycode (w/o modifiers) <37> PEA TestDead ; Push address of dead key state _KeyTrans CMP.W (SP)+,D4 ; compare testChar with first char <37> BEQ.S @FixStackReturn ; if equal, clean up stack & return CMP.W (SP)+,D4 ; compare testChar with second char <37> RTS ; return Z set or clear, indicates result @FixStackReturn ADDA.W #2,SP ; fix stack w/o changing cond codes RTS ; return with Z set. TestDead dc.l 0 ; storage for dead state endwith endproc ;------------------------------------------------------------------------------- <33> ; FUNCTION FindCharInSet(textPtr: Ptr; textLen: LongInt; charSet: StringPtr; ; table: CharByteTable): LongInt; ; ; The textPtr and textLen parameters specify a string to be searched for any ; of the characters in charSet. If any are found, the offset where the ; character was found is returned; otherwise, the function returns -1. ; ; The table parameter is obtained from the Script Mgr ParseTable routine. ; The caller must set the txFont of the port to a font in the script being ; handled, then call ParseTable to get the table. ; ; This routine is used by Dialog Mgr and Finder (and Help Mgr?). ; Written by Kevin S. MacDonell. ;------------------------------------------------------------------------------- proc export FindCharInSet FCISFrame RECORD {A6Link},decr fcisresult DS.L 1 txtPtr DS.L 1 txtLen DS.L 1 charSetPtr DS.L 1 tblPtr DS.L 1 selector DS.L 1 ; Script Mgr selector <36> fcisparamSz EQU fcisresult-* ReturnAddr DS.L 1 A6Link DS.L 1 ENDR fcisSaveReg REG D2-D7/A2-A4 ; Register conventions for this routine ; D0 - The char from the text buffer we are looking at ; D1 - The char from the charset we are looking at ; D2 - length of character in charset ; D3 - offset into charset ; D4 - offset into text ; D5 - subrange counter (bytes into char from charset) ; D6 - The # of BYTES in the charset (because there may be double-byte chars in it) ; D7 - The text length in bytes (not chars, we assume caller does not know this) ; A4/D4 - txtPtr and offset ; A3/D3 - charSetPtr and offset ; A2 - tblPtr ; A1 - subrange pointer into charset ; A0 - subrange pointer into text FindCharInSet WITH FCISFrame link a6,#0 movem.l fcisSaveReg,-(sp) moveq #-1,d7 move.l d7,fcisresult(a6) ; Assume we wonÕt find anything move.l txtLen(a6),d7 ; Get the length of the text to search ble.s @done ; donÕt bother if itÕs bogus move.l charSetPtr(a6),a3 ; Get base of string moveq #0,d6 ; Clear high part move.b (a3)+,d6 ; Get length byte and bump pointer past it beq.s @done ; If no chars to search for, bail moveq #0,d0 ; Clear text byte moveq #0,d1 ; Clear charset byte moveq #0,d2 ; Clear subrange counter move.l txtPtr(a6),a4 ; Get the text ptr move.l tblPtr(a6),a2 ; Get the table ptr move.b (a3),d1 ; Preload d1 with single char to preflight special case ; Since it never changes during textloop ; Loop thru each char in the text and compare it with each char in the charset ; If we find a match, return the byte offset into the text where the match starts moveq #0,d4 ; Start at offset zero into text @textLoop ; while (offsetintotext (d4) < textlen) do move.b (a4,d4.l),d0 ; Get first byte of next char in text cmp.w #1,d6 ; Is the charset only 1 byte long? (special case) beq.s @fastCompare moveq #0,d3 ; Start at offset zero into charset @charsetLoop: ; while (offsetintocharset(d3) < charsetlen) do lea (a4,d4.l),a0 ; Point to current byte in text string lea (a3,d3.l),a1 move.b (a1),d1 ; Get first byte of next char in charset move.b (a2,d1.l),d2 ; Get the length of this charset character move.l d2,d5 ; Copy to loop counter @subcharsetloop: cmpm.b (a0)+,(a1)+ ; Did we find it? bne.s @charsetLoopNext ; Nope, check the next char in the charset dbf d5,@subcharsetloop ; Go check the next one bra.s @foundit ; If we fell out of loop, we found it! @charsetLoopNext: addq.l #1,d3 ; Advance 1 byte in the char set add.l d2,d3 ; Advance more bytes if necessary, past end of char cmp.l d3,d6 ; Checked all the chars in the charset? bgt.s @charsetLoop ; no, keep going bra.s @textLoopNext ; yep, check next char in text ; This is the short-circuit compare loop when we are searching for a single 1-byte character @fastCompare cmp.b d0,d1 ; Did we find it? bne.s @textLoopNext @foundit move.l d4,fcisresult(a6) ; Return the offset into the text where we matched bra.s @done @textLoopNext addq.l #1,d4 ; Point to next character in the text move.b (a2,d0.l),d0 ; Get number of additional chars add.l d0,d4 ; And point past those cmp.l d4,d7 ; Checked all the chars in the text? bgt.s @textLoop ; keep going @done movem.l (sp)+,fcisSaveReg unlk a6 move.l (sp)+,a0 moveq #fcisparamSz,d0 add.w d0,sp jmp (a0) endproc ; ---------------------------------------------------------------------------- ; StdUnlink, StdExit ; Standard point of return for script manager routines. ; Input ; d0 := number of arguments passed to returning routine ; sp := address of jump target routine ; ---------------------------------------------------------------------------- proc export StdUnlink, StdExit ; standard exit points StdUnlink unlk a6 ; unlink the stack. StdExit move.l (sp)+,a0 ; pop return address. add.w d0,sp ; pop arguments. jmp (a0) ; return to the caller. endproc ; ----------------------------------------------------------------------- <1.8> ; Patch out LwrString to handle 2-byte chars. ; ---------------------------------------------------------------------------- ; routine: LwrString ; input: a0 textPtr ; d0.w length ; d1.w trap word; the following bits are significant in 7.0 only: ; Opcode bits ; 10 9 Function ; -- -- -------- ; 0 0 convert to lower-case ; 0 1 strip diacritics ; 1 0 convert to upper-case ; 1 1 convert to upper-case and strip diacritics ; output: d0.w error ; function: Change text pointed to by a0 according to opcode bits. Before 7.0, we ; just assume that these bits are 0 and act accordingly. ; ----------------------------------------------------------------------------- ; Add a new entry point for ScriptUtil. Like LwrString, but params on stack, ; and two additional params: script specifies the script (so we don't need a ; grafPort), and func selects which function (Upper, Lower, etc.) using the same ; bits as in the OS trap word. ; ; PROCEDURE SCLwrString(textPtr: Ptr;len: INTEGER;script: ScriptCode; ; func: INTEGER); ; ; ---------------------------------------------------------------------------- proc export NewLwrString, SCLwrString ; <38><2> lwrTrFrame record {a6link},decr return ds.l 1 ; return address a6link ds.l 1 ; link pointer sourcePtr ds.l 1 ; orig source ptr sourceLen ds.l 1 ; orig source len sourceHndl ds.l 1 ; new handle with copy of source destHndl ds.l 1 ; new handle for transliterate result errCode ds.w 1 ; err code to be returned in d0 target ds.w 1 ; target for Transliterate script ds.w 1 ; script code <38> lwrTrLocals equ * ; size of locals endr opcodeMask equ $0600 ; mask for opcode bits stripOnly equ $0200 ; opcode bits for strip diacritics only ; New entry point, ScriptUtil routine <38> SCLwrString move.l (sp)+,a1 ; pop return address <38> addq #4,sp ; discard selector <38> move.w (sp)+,d1 ; get func code (bits 9-10 like trap word) <38> move.w (sp)+,d2 ; get ScriptCode for later <38> move.w (sp)+,d0 ; get length where OS trap would have itÉ <38> move.l (sp)+,a0 ; and pointer where OS trap would have it. <38> move.l a1,-(sp) ; restore return address <38> cmp.w #smSystemScript,d2 ; check ScriptCode <38> blt.s useFontScript ; FontScript, go get it <38> with SMgrRecord,ScriptRecord ; <38> movea.l IntlSpec,a1 ; doesn't affect cc <38> bgt.s @haveRealScript ; <38> move.w smgrSysScript(a1),d2 ; get system script <38> @haveRealScript move.w d2,-(sp) ; save script code <38> lsl.w #2,d2 ; convert to long offset. <38> move.l smgrEntry(a1,d2.w),d2 ; script installed? <38> beq lwrCleanup ; no, do nothing <38> move.l d2,a1 ; load ScriptRecord pointer. <38> tst.b scriptEnabled(a1) ; script enabled? <38> beq lwrCleanup ; if so, go dispatch <38> move.w (sp)+,d2 ; restore ScriptCode <38> bra.s haveValidScript ; <38> endwith ;SMgrRecord,ScriptRecord <38> ; Old entry point, OS trap NewLwrString ; <2> ; ---------------------------------------------------------------------------- ; NOTE: For 2-byte scripts, we need to call Transliterate. So, the first thing to ; do is figure out what script we're in. We also test for length <= 0 (tests >32K). ; ---------------------------------------------------------------------------- useFontScript ; <38> movem.l a0/d0/d1,-(sp) ; save important registers subq.l #2,sp ; make room for return _FontScript ; find script of port, ScriptRecord in a0 move.w (sp)+,d2 ; pop script into d2 move.l a0,a1 ; put ScriptRecord ptr in a1 <38> movem.l (sp)+,a0/d0/d1 ; restore important registers haveValidScript ; <38> ; Here we have: ; <38> ; a0 textPtr ; d0.w len ; d1.w bits 9-10 have func flags ; a1 ScriptRecord ptr ; d2 real script code ext.l d0 ; as fast as tst.w and we need ext.l later <38> move here ble lwrRTS ; if bad length, quit <38> move here ; ---------------------------------------------------------------------------- ; Here we make use of the fact that a word redraw flag of 1 (or anything >0) ; indicates a 2-byte script. ; Now we already have ScriptRecord ptr in a1, and we know script is enabled. <38> ; ---------------------------------------------------------------------------- with ScriptRecord ; <38> tst.b scriptRedraw(a1) ; is it a 2-byte script? ble not2Byte ; if not, go use normal LwrString endwith ;ScriptRecord ; ---------------------------------------------------------------------------- ; OK, we need to set up for Transliterate: set up source & dest handles. ; Also set target depending on opcode bits . ; ---------------------------------------------------------------------------- with lwrTrFrame link a6,#lwrTrLocals ; create local storage move.w d2,script(a6) ; save script code <38> ; ------------ ; Set target depending on opcode bits . clr.w errCode(a6) ; start with no errors move.w #smTransLower+smTransAscii,target(a6) ; assume lower-casing and.w #opcodeMask,d1 ; isolate opcode bits beq.s @gotTarget ; if 00, go with lower-casing cmp.w #stripOnly,d1 ; if just stripping diacriticsÉ beq lwrTrUnlk ; nothing to do in 2-byte system move.w #smTransUpper+smTransAscii,target(a6) ; else upper-casing @gotTarget ; ------------ move.l a0,sourcePtr(a6) ; save source ptr move.l d0,sourceLen(a6) ; save length _PtrToHand ; make new handle containing copy of text move.w d0,errCode(a6) ; save err code bne lwrTrUnlk ; if error in PtrToHand, quit CSS move.l a0,sourceHndl(a6) ; save new source handle move.l sourceLen(a6),d0 ; get length again _NewHandle ; make new handle with random contents move.w d0,errCode(a6) ; save err code bne.s lwrTrDisp1Hndl ; if error in NewHandle, quit ; ---------------------------------------------------------------------------- ; Now do Transliterate and check result: dest length should equal source length ; ---------------------------------------------------------------------------- move.l a0,destHndl(a6) ; save new dest handle subq.l #2,sp ; space for Transliterate error code move.l sourceHndl(a6),-(sp) ; push source handle move.l a0,-(sp) ; push dest handle (still in a0) move.w target(a6),-(sp) ; use specified target move.l #smMaskAscii,-(sp) ; convert Roman only move.w script(a6),-(sp) ; push ScriptCode <38> _SCTransliterate ; <38> move.w (sp)+,errCode(a6) ; save error code bne.s lwrTrDisp2Hndl ; if error in Transliterate, quit move.l destHndl(a6),a0 ; now check resultÉ _GetHandleSize move.w d0,errCode(a6) ; save err code tst.l d0 ; .l, because the result is really a long blt.s lwrTrDisp2Hndl ; if error in GetHandleSize, quit move.w #-1,errCode(a6) ; assume len err; need a better err code! cmp.l sourceLen(a6),d0 ; should be same as source len bne.s lwrTrDisp2Hndl ; if not, set err and bail ; ---------------------------------------------------------------------------- ; Copy result (destHndl) to original text buffer (sourcePtr). ; NOTE: For large text blocks, _BlockMove might be faster than this loop. ; ---------------------------------------------------------------------------- move.l destHndl(a6),a0 ; get dest handle andÉ move.l (a0),a0 ; deref it to get source ptr for this copy move.l sourcePtr(a6),a1 ; old source ptr is dest for this copy move.l sourceLen(a6),d0 ; length for copy (we know it is >= 1) subq.l #1,d0 ; set up for dbra @1 move.b (a0)+,(a1)+ ; copy a byte dbra d0,@1 ; loop till done clr.w errCode(a6) ; no errors! ; ---------------------------------------------------------------------------- ; Exits - need to dispose of handles we created ; ---------------------------------------------------------------------------- lwrTrDisp2Hndl move.l destHndl(a6),a0 ; _DisposHandle ; lwrTrDisp1Hndl move.l sourceHndl(a6),a0 ; _DisposHandle ; lwrTrUnlk move.w errCode(a6),d0 ; set err code unlk a6 ; rts endwith lwrCleanup ; <38> addq #2,sp ; discard saved script code <38> lwrRTS clr.w d0 rts ; ---------------------------------------------------------------------------- ; This is not a 2-byte script, just use old LwrString. ; ---------------------------------------------------------------------------- not2Byte ; We used to jump back into ROM here with "BackToTrap oldLwrString". Now we <38> ; patch out LwrString entirely, so we add the code below. ; Instead of saving/clearing IntlForce, calling GetIntl, ; then restoring IntlForce, we now just call GetScriptItl. move.l a2,-(sp) ; save a2 <03/05/89 pke> ; actually, OS trap dispatch saves & restores a2 - strange but true <06/05/89 pke> movem.l a0/d0/d1,-(sp) ;*save around IUGetScriptItl (ugly temp hack) ; <38> clr.l -(sp) ; space for returned handle move.w #2,-(sp) ; select itl2 move.w d2,-(sp) ; push ScriptCode <38> clr.w -(sp) ; sysFlag = 0 <38> _IUGetScriptItl ; may trash a0,a1,d0-d2 <38> move.l (sp)+,a2 ; store itl2 handle ; <38> movem.l (sp)+,a0/d0/d1 ;*(ugly temp hack) move.l a2,d2 ; nil handle? <06/05/89 pke> beq.s @LwrError ; bail if so <06/05/89 pke> move.l (a2),a2 ; dereference btst.b #0,itl2FlagsOffset+1(a2) ; extended itl2 tables? beq.s @LwrError ; no, bail (was beq to @LwrExit) <06/05/89 pke> move.l a2,a1 ; copy pointer clr.l d2 ; for longizing move.w classArrayOffset(a2),d2 ; longize classArrayOffset add.l d2,a1 ; make classArray pointer ; Opword = 1010 xcdx xxxx xxxx , where c=caseBit and d=diacBit. Shift & mask ; to form 0000 0000 0000 0CD0 for use as an address offset. <03/28/89 pke> lsr.w #8,d1 ; xxxx xxxx 1010 xcdx <03/28/89 pke> andi.w #$0006,d1 ; 0000 0000 0000 0cd0 <03/28/89 pke> move.w @LwrOffsetTable(d1.w),d1 ; offset into itl2 offset table <03/28/89 pke> move.w 0(a2,d1.w),d2 ; now get actual table offset <03/28/89 pke> add.l d2,a2 ; make lowerList pointer clr.l d1 ; wordize bra.s @LwrNext ; loop at bottom @LwrLoop move.b (a0),d1 ; char move.b 0(a1,d1.w),d1 ; class move.b 0(a2,d1.w),d1 ; delta add.b d1,(a0)+ ; add delta to make lower @LwrNext dbra d0,@LwrLoop ; until d0 = -1 @LwrExit clr.l d0 ; no error @LwrExit2 ; <06/05/89 pke> move.l (sp)+,a2 ; restore a2 <03/05/89 pke> rts @LwrError ; <06/05/89 pke> move.w #resNotFound,d0 ; <06/05/89 pke><07/08/89 pke> bra.s @LwrExit2 ; <06/05/89 pke> @LwrOffsetTable ; <03/28/89 pke> dc.w lowerListOffset ; <03/28/89 pke> dc.w noMarkListOffset ; <03/28/89 pke><04/07/89 pke> dc.w upperListOffset ; <03/28/89 pke> dc.w upperNoMarkListOffset ; <03/28/89 pke> endproc ;------------------------------------------------------------------------------- <37> ; FUNCTION TestLetter(testChar: CHAR): BOOLEAN; {Pascal calling conventions} ; ; This function tests if a key on the main keyboard is being pressed that could ; generate testChar with Command up or down (and no other modifiers). This is only ; intended to test for Roman lower-case letters. It checks for the key press by ; examining the low-memory Keymap area, so this is useful when we are not in an ; event loop. We check with Command bit on because this forces the Roman layout ; on a non-Roman keyboard. ; ; Example of usage from assembly language to test for Opt-e: ; ; btst #2,KeyMap+7 ; option key down? ; beq.s @done ; no, skip check. ; subq #2,sp ; make room for Boolean result ; move.w #'e',-(sp) ; push 'e' as the char to test for ; bsr TestLetter ; returns TRUE if key with Roman 'e' being pressed ; tst.b (sp)+ ; what was the result? ; bne SkipInstall ; if Opt-e, skip script install ; ;------------------------------------------------------------------------------- proc export xTestLetter, iTestLetter import DoKeyTrans clearModifiers equ $FFFF7F80 ; and mask to clear modifier bits in (KeyMap+4).L keyUpMask equ $0080 ; or mask to set key up bit in keycode cmdOnMask equ $0100 ; or mask to set CmdKey bit in keycode tlFrame record {a6link},decr result ds.w 1 ; Boolean result tlArgStart equ * testChar ds.w 1 ; Char parameter to test for tlArgEnd equ * return ds.l 1 ; return address a6link ds.l 1 ; link register tlLocals equ * tlArgSize equ tlArgStart-tlArgEnd endr tlRegs reg a2/d3-d4 ; regs to save ; Local regs: ; a2.l KCHRPtr ; d3.w keycode ; d4.w testChar xTestLetter ; external entry <44> move.l (sp)+,(sp) ; discard selector but save return addr <44> iTestLetter ; internal entry <44> ;------------------------------------------------------------------------------- ; Check if we have a non-modifier key down on the main keyboard (not the keypad ; etc.). We look in the KeyMap bit array to see if a bit is set that indicates a ; non-modifier key is pressed. KeyMap is 128 bits, so we can test 4 longs. ; However, we skip the last 2 longs, because they are only for the keypad, arrow ; keys or special keys on the extended keyboard. ;------------------------------------------------------------------------------- CLR.W 6(SP) ; Assume result FALSE MOVEQ #0,D1 ; bit offset in KeyMap MOVE.L KeyMap,D0 ; Key down in (KeyMap+0).L? BNE.S GotKey ; If so, handle it MOVEQ #32,D1 ; bit offset in KeyMap MOVE.L KeyMap+4,D0 ; Get (KeyMap+4).L AND.L #clearModifiers,D0 ; Is non-modifier key down? BEQ.S NoKey ; If not, give up ;------------------------------------------------------------------------------- ; Here, we have a non-modifier key down on the main keyboard. At this point, D0 ; is guaranteed to have at least one non-zero bit. We determine the keycode ; modulo 32 based on the position of this bit in D0. Then we add in the bit ; offset from the beginning of KeyMap to the 32-bit block that the key down bit ; was in (this value is in D1). This gives us the keycode. ;------------------------------------------------------------------------------- GotKey with tlFrame LINK A6,#tlLocals movem.l tlRegs,-(sp) ; save regs move.w testChar(a6),d4 ; save testChar ;------------------------------------------------------------------------------- ; Set up KeyTrans parameter: keycode (in d3) ; Note that modifiers byte will be all 0 (this is what we want) ;------------------------------------------------------------------------------- MOVEQ.L #31,d3 ; Loop starts testing from 31 @bitLoop BTST.L d3,d0 ; Is selected bit set in D0? DBNE d3,@bitLoop ; No, try next. Guaranteed to find one. ; Now d3.W contains the number of the bit that was set in D0.L. MOVE.W d3,d0 ; Copy bit number AND.W #$07,d3 ; Get bit number within byte AND.W #$F8,d0 ; Get bit offset of byte in register ADD.W #24,d3 ; Byte's bit offset in KeyMap is É SUB.W d0,d3 ; É 24 - bit offset in register ; Now we have keycode mod 32 in d3. ADD.W d1,d3 ; Add in Keymap block bit offset (0 or 32). ; Now we have keycode in d3.w OR.W #keyUpMask,d3 ; Set key up bit. This will make ; KeyTrans skip dead key processing. ;------------------------------------------------------------------------------- ; Get KeyTrans parameter: KCHRPtr (in a2) ;------------------------------------------------------------------------------- with ExpandMemRec MOVE.L ExpandMem,A0 ; Pointer to ExpandMemRec MOVE.L emKeyCache(A0),a2 ; Save pointer to KCHR resource endwith ;ExpandMemRec ;------------------------------------------------------------------------------- ; Call KeyTrans with various modifier key settings ;------------------------------------------------------------------------------- ST result(A6) ; Assume we have a match BSR DoKeyTrans ; First, call with no modifiers BEQ.S DoneTest ; If that gave us a match, hooray OR.W #cmdOnMask,d3 ; Turn on Command and try once more BSR DoKeyTrans ; Almost doneÉ SZ result(A6) ; Our final result ;------------------------------------------------------------------------------- ; Clean up and exit ;------------------------------------------------------------------------------- DoneTest movem.l (sp)+,tlRegs ; restore regs UNLK A6 ; NoKey MOVE.L (SP)+,A0 ; pop return address ADDQ.L #tlArgSize,SP ; clean up parameter space JMP (A0) ; return to caller endwith ;tlFrame endproc ;------------------------------------------------------------------------------- <50> ; GetScript/SetScript for Roman ; ; These do nothing but clean up the stack and return a constant value. ;------------------------------------------------------------------------------- proc export RomanGetScript, RomanSetScript gsRecord record {return},decr result ds.l 1 ; result code. gsArgs equ *-4 ; size of arguments. script ds.w 1 ; script code. verb ds.w 1 ; verb value. selector ds.l 1 ; trap selector. return ds.l 1 ; return address. gsLocals equ * ; size of local variables. endr RomanGetScript with gsRecord move.l (sp)+,a0 ; pop return address. addq #gsArgs,sp ; discard arguments. clr.l (sp) ; return value jmp (a0) ; return to the caller. endwith ;gsRecord ssRecord record {return},decr result ds.w 1 ; result code. ssArgs equ *-4 ; size of arguments. script ds.w 1 ; script code. verb ds.w 1 ; verb value. param ds.l 1 ; parameter value. selector ds.l 1 ; trap selector. return ds.l 1 ; return address. ssLocals equ * ; size of local variables. endr RomanSetScript with ssRecord move.l (sp)+,a0 ; pop return address. add.w #ssArgs,sp ; discard arguments. move.w #smBadVerb,(sp) ; set error code. jmp (a0) ; return to the caller. endwith ;ssRecord endproc ; ---------------------------------------------------------------------------- <54> ; function: CharType(textBuf: Ptr; textOffset: Integer): Integer; ; input: (sp).l Text pointer. ; (sp).w Text offset. ; output: (sp).w Result, character type. ; warning: This routine follows Pascal register conventions. ; ; Return information about a character, including character type, punctuation ; type, and case. For RIS, this is reduced to a simple table lookup. ; ---------------------------------------------------------------------------- proc export CharType ctRecord record {a6link},decr result ds.w 1 ; result. ctArgs equ *-8 ; size of arguments. textBuf ds.l 1 ; text buffer pointer. textOffset ds.w 1 ; text buffer offset. scriptRecPtr ds.l 1 ; Scriptrecord ptr return ds.l 1 ; return address. a6link ds.l 1 ; old a6 register. ctLocals equ * ; size of local variables. endr caseBit equ 14 ; case bit index in returned word dirBit equ 13 ; dir bit index in returned word <54> charMask equ $0f ; mask for character type. punctMask equ $70 ; mask for punctuation class in itl2 (L-R scripts) rlPunctMask equ $30 ; mask for punctuation class in itl2 (R-L scripts) <54> dirBitInItl2 equ 6 ; dir bit number in Itl2 type byte <54> ctRegs reg a2/a3 ; CharType with ctRecord move.l 4(sp),a0 ; ScriptRecord ptr (maybe nonRoman) moveq #0,d2 ; sysFlag=0 in hi word move.b ScriptRecord.scriptID(a0),d2 ; script code in low word clr.l -(sp) ; space for returned handle move.w #2,-(sp) ; select itl2 move.l d2,-(sp) ; two arguments: script code, sysFlag=0 _IUGetScriptItl ; may trash a0,a1,d0-d2 move.l (sp)+,d0 ; store itl2 handle move.l (sp)+,a0 ; pop return address. move.l (sp)+,d2 ; save scriptRecPtr in d2 <54> move.w (sp)+,d1 ; get character offset. move.l (sp)+,a1 ; get text buffer pointer. movem.l ctRegs, -(sp) ; save regs tst.l d0 ; nil handle? beq.s @CharTypeExit ; if so, bail (return 0) move.l d0,a2 ; get handle in a2 clr.l d0 ; for longizing & err return move.l (a2),a2 ; dereference btst.b #0,itl2FlagsOffset+1(a2) ; extended itl2 tables? beq.s @CharTypeExit ; no, bail (returns 0) move.l a2,a3 ; copy move.w classArrayOffset(a2),d0 ; longize add.l d0,a2 ; move.w typeListOffset(a3),d0 ; add.l d0,a3 ; clr.l d0 ; clear character code. move.b 0(a1,d1.w),d0 ; get the character code. move.b 0(a2, d0.w),d0 ; get character class and move.b 0(a3, d0.w),d0 ; specific type MOVEQ #0,D1 ; clear it, we are going to shit later <8> move.b d0,d1 ; punctuation type. bpl.s @1 ; move case bit to the bset #caseBit,d0 ; left. @1 andi.b #charMask,d0 ; isolate character type. move.l d2,a1 ; scriptRecPtr <54> tst.b ScriptRecord.scriptRight(a1) ; right-to-left script? <54> beq.s @dontSetDirBit ; if not, don't check dir bit <54> ; for right-left scripts, itl2 table has 2 bits for type + 1 dir bit <54> btst #dirBitInItl2,d1 ; does byte in table indicate R-L char? <54> beq.s @dontSetDirBit ; if not, go handle punct sub-types <54> bset #dirBit,d0 ; return R-L direction <54> andi.b #rlPunctMask,d1 ; and isolate punctuation sub-type <54> bra.s @setType ; <54> @dontSetDirBit ; <54> andi.b #punctMask,d1 ; isolate punctuation sub-type. @setType ; <54> lsl.w #4,d1 ; or.w d1,d0 ; or punctuation type back @CharTypeExit movem.l (sp)+,ctRegs ; move.w d0,(sp) ; into character type. jmp (a0) ; return to the caller. endWith endproc ;____________________________________________________________ ; Routine StyledLineBreak ( ; textPtr: Ptr; ; textLen: Longint; {must be < 32K ;<2/14/89 pke>} ; textStart: Longint; ; textEnd: Longint; ; flags: Longint; ; var textWidth: Fixed; {on exit, set if too long} ; var textOffset: Longint; ; ): LineCode; ;____________________________________________________________ LineBreakFrame record {oldA6},decrement result ds.w 1 argSize equ *-8 textPtr ds.l 1 textLen ds.l 1 textStart ds.l 1 textEnd ds.l 1 flags ds.l 1 textWidth ds.l 1 textOffset ds.l 1 selector ds.l 1 return ds.l 1 oldA6 ds.l 1 offsets ds.l 3 leadingEdge ds.b 1 foundCR ds.b 1 lineDirection ds.w 1 oldBlockFlags ds.w 1 ; only a byte is used savedTextWidth DS.L 1 ; fixed value localFrame equ * endR FixMinusOne equ $FFFF0000 HiByteFlags EQU ScriptRecord.scriptBundle.itlbFlags LoByteFlags EQU HiByteFlags+1 LineBreakRegs reg a2-a3/d4-d6 ;____________________________________________________________ StyledLineBreak proc EXPORT ; <8> import FindCarriage import StdUnlink ; setup with LineBreakFrame CheckSelector link a6,#localFrame movem.l LineBreakRegs,-(sp) ; common args move.l textWidth(a6),a3 ; get @width move.l textPtr(a6),d5 ; pointer add.l textStart(a6),d5 ; pointer+start ; save environment and reset ;!!! generalize for left-right move.w teSysJust,lineDirection(a6) ; save just move.w #0,teSysJust ; set to LR, disable formating of RL scripts ; get current script move.w #0,-(sp) ; allocate _FontScript return _FontScript ; get current script move.w (sp)+,d0 ; current script ; get core globals and test: inline instead of trap, for speed lsl.w #2,d0 ; make script code a longword offset <1.9> GetSmgrCore a2 ; smgr core globals move.l smgrRecord.smgrEntry(a2,d0),a2 ; get the script record ptr move.b HiByteFlags(a2),oldBlockFlags(a6) ; save the high byte of the itlb flags bclr.b #smsfReverse,HiByteFlags(a2) ; set reverse block bit, disable reversing text for RL scripts ; quick check on length move.l textEnd(a6),d4 ; get length sub.l textStart(a6),d4 ; segment length ble @TooLong ; if zero, bail tst.l (a3) ; no width (degenerate) ; changed this so we handle blanks at start of 0-width line. <06/09/89 pke><3> bmi @FixNoChars ; fix neg width ; first search for a carriage return, try minimum buffer for NPixel2Char MOVE.L D5,A0 ; pass text ptr (TextPtr + start offset) MOVE.W D4,D0 ; pass textlength (start offset - end offset) BSR FindCarriage ; returns the offset after CR in D1 MOVE.B D0,foundCR(A6) ; D0=true if a carriage return was found,save this value MOVE.W D1,D4 ; update the textlength ; now try to find how much of the text (D4) fits in the line pixel width MOVE.L (A3),savedTextWidth(A6) ; save this value, can be changed by NP2C MOVE.W #0,-(SP) ; space for result MOVE.L D5,-(SP) ; push text ptr MOVE.L D4,-(SP) ; push text byte length MOVE.L #0,-(SP) ; 0 slop MOVE.L (A3),-(SP) ; line pixel width PEA leadingEdge(A6) ; leading Edge flag MOVE.L A3,-(SP) ; remaing with MOVE.W #smOnlyStyleRun,-(SP) ; style run position MOVE.L #$00010001,D0 ; 1/1 scaling MOVE.L D0,-(SP) ; num MOVE.L D0,-(SP) ; denum _NPixel2Char ; call trap MOVE.L #0,D6 ; longize MOVE.W (SP)+,D6 ; pop char offset ; if width is zero, fix leadingEdge for FindWord etc. tst.l savedTextWidth(A6) ; zero width? bne.s @doneFixleadingEdge ; st leadingEdge(a6) ; if so, fix leadingEdge @doneFixleadingEdge ; check for position being too long move.l d6,d0 ; copy un-offsetted length add.l textStart(a6),d6 ; get char offset ; if offset > length, return width of text cmp.l d4,d0 ; position at end? blt.s @GotCharPos ; no, skip tst.b leadingEdge(a6) ; test if D4=D0 and leadingEdge is false BEQ.S @GotCharPos ; if so, skip TST.B foundCR(A6) ; was a CR found ? BEQ.S @TooLong ; the pix width is too big for the line MOVE.L D6,D1 ; update D1 with the whole offet <10> BRA @ReturnWord ; we had CR so, return a word @GotCharPos ; get word around char offset move.l textPtr(a6),-(sp) ; ptr move.w textLen+2(a6),-(sp) ; length (mod) move.w d6,-(sp) ; offset (truncate) move.b leadingEdge(a6),-(sp) ; leadingEdge move.l MinusOne,-(sp) ; line break table pea offsets(a6) ; offset table _FindWord ; use trap ; test character to see if it is white-space ; Mark suggests checking to see if VisibleLength would work better hereÉ <06/09/89 pke> move.w #0,-(sp) ; allocate return move.l textPtr(a6),-(sp) ; ptr move.w offsets(a6),-(sp) ; offset _CharType ; use trap move.w (sp)+,d0 ; get type move.l #0,d1 ; longize move.w offsets(a6),d1 ; assume second offset *** and.w #smcTypeMask+smcClassMask,d0 ; type and class cmp.w #smCharPunct+smPunctBlank,d0 ; blank? bne.s @ReturnOffset ; no, continue btst.b #smsfReverse,oldBlockFlags(a6) ; test reverse block flag sne d0 ; 0/-1 left/right cmp.b LineDirection+1(a6),d0 ; line = char? (bottom byte of line) bne.s @ReturnOffset ; yes, skip to end ; here, word is whitespace and direction is ok (script direction = line direction), ; so return second offset. MOVE.W offsets+2(A6),D1 ; set to second offset BRA.S @ReturnWord ; we broke at word boundary @TooLong move.l textEnd(a6),d6 ; return width move.l #smBreakOverflow,d0 ; set type bra.s @Done ; return @ReturnOffset tst.l d1 ; break at start? bne.s @ReturnWord ; yes, return char move.l textOffset(a6),a0 ; get @textOffset tst.l (a0) ; was offset 0 at entry? beq.s @ReturnWord ; if so, go return zero offset ; have to break word, so backup until length is less. ; The most we have to backup is one char, and we only have to do that if ; leadingEdge is false . We also need to catch the case of d6=0. tst.b leadingEdge(a6) ; leadingEdge? bne.s @checkNullOffset ; if T, skip decrement sub.l #1,d6 ; decrement BTST.B #smsfSingByte,LoByteFlags(A2) ; is it a single byte script ? BNE.S @checkNullOffset ; don't fall thru if single byte script clr.w -(sp) ; allocate return move.l d5,-(sp) ; pass text ptr move.l d6,d0 ; cur position sub.l textStart(a6),d0 ; start of real text move.w d0,-(sp) ; count (mod!!!) _CharByte tst.w (sp)+ ; return 0=single,-1=first,1=last ble.s @checkNullOffset ; bail if -1 or 0, ok sub.l #1,d6 ; fix for 2-byte chars @checkNullOffset tst.l d6 ; are we still >0? bgt.s @ReturnChar ; if so, go return a char bra.s @FixNoChars1 ; don't redo test for orig offset 0 @FixNoChars move.l textOffset(a6),a0 ; get @textOffset tst.l (a0) ; was offset 0 at entry? bne.s @FixNoChars1 ; if not, return 1 char moveq #0,d1 ; if so, set zero offset bra.s @ReturnWord ; and go return word break @FixNoChars1 ; string is now zero length, make it at least 1 char move.l #1,d6 ; include first char BTST #smsfSingByte,LoByteFlags(A2) ; is it single byte script ? BNE.S @ReturnChar ; don't fall thru if single byte script clr.w -(sp) ; allocate return move.l d5,-(sp) ; pass text ptr move.w #1,-(sp) ; offset _CharByte tst.w (sp)+ ; return 0=single,-1=first,1=last ble.s @ReturnChar ; bail if -1 or 0, ok add.l #1,d6 ; fix for 2-byte chars @ReturnChar move.l #smBreakChar,d0 ; so, word too long. bra.s @Done ; exit @ReturnWord moveq #0,d6 ; make long move.w d1,d6 ; set to word bound move.l #smBreakWord,d0 ; break at word @Done move.l textOffset(a6),a0 ; get @textOffset move.l d6,(a0) ; set to char position move.b d0,result(a6) ; set result type ; restore environment move.b oldBlockFlags(a6),HiByteFlags(a2) ; restor the high byte of itlb flags move.w lineDirection(a6),teSysJust ; restore just ; cleanup movem.l (sp)+,LineBreakRegs CheckA6 move #argSize, d0 ; for StdUnlink bra StdUnlink ; standard exit endWith endProc ;____________________________________________________________ ; Routine FindCarriage ; Input a0.l ptr ; d0.w length ; Output d0.b $FF/0 found/not found ; d1.w offset from ptr to char after CR; =length if CR not found ; Uses Pascal regs ;____________________________________________________________ FindCarriage proc With smgrRecord, scriptRecord ; <8> move.w d0,d1 ; copy for later move.b #$0D,d2 ; carriage return bra.s @CheckLength ; zero check @CarriageLoop cmp.b (a0)+,d2 ; is it? @CheckLength dbeq d0,@CarriageLoop ; keep going? beq.s @GotCarriage ; not found sf d0 ; signal caller bra.s @FindCarriageDone ; done @GotCarriage ; found a CR. Set up length and leftside. length is to character AFTER cr. sub.w d0,d1 ; - characters left (+1) <2/14/89 pke><3> st d0 ; signal caller @FindCarriageDone rts endWith endProc ;____________________________________________________________ end