   10REM SAVE"$.Arabic.Source.Cli"
   20HelpHandler = A%
   30PROCConsts
   40PROCVars
   50DIM O% &BFFF-P%
   60Q%=O%:R%=P%
   70table=&A8 :REM Safe two-bytes for decoding *-commands ????????
   80data=FNzp(2)
   90user=&F2
  100Param_Text = 256+1
  110Param_Numerals = 256+2
  120Param_Off = 256+3
  130Param_On = 256+4
  140Param_Printer = 256+5
  150Param_Normal = 256+6
  160Param_Wide = 256+7
  170Alphabet_Latin1 = 101
  180Alphabet_Latin2 = 102
  190Alphabet_Latin3 = 103
  200Alphabet_Latin4 = 104
  210Alphabet_BFont = 100
  220rest_comm_line=&F2 :REM location used by OSCLI for start addr. of command
  230text_terminator=&00:REM to be compatible with ROM header
  240MaxComLen = 8      :REM Fixed max length of commands used to calc offset
  250NumCommands = 9    :REM Number of *-commands recognised
  260REM 10 to add *KEYBOARD
  270NumParams = 24     :REM No. of different parameters recognised by
  280                   :REM generic parser.
  290osnewl=&FFE7
  300oswrch=&FFEE
  310FOR Pass=4 TO 6+L% STEP 2+L%
  320O%=Q%:P%=R%
  330[OPT Pass
  340\
  350\*******************************************************************
  360\*
  370\*   Arabic command parser
  380\*
  390\*   Derived from HELP system (hence the label names!)
  400\*
  410\*   On entry (rest_comm_line),Y points to start of the user's command
  420\*   This routine gets each word and compares it with a table of
  430\*   keywords. If a match is found, the appropriate code is entered
  440\*   If a command doesn't match, it is ignored.
  450\*
  460\*   Everything is preserved on exit if the command is not recognised
  470\*
  480\*******************************************************************
  490\
  500.CommandHandler
  510\
  520\
  530   Lda user                 \ preserve parameter pointer
  540   Pha                      \ for other roms.
  550   Lda user+1
  560   Pha
  570   Jsr add_offset          \ synchronise pointers for string comparisons
  580\
  590.help_skip_spaces
  600   Ldy #0
  610   Lda (user),Y            \ skip leading spaces
  620   Cmp #&0D                \ check for OSCLI string terminator
  630   Beq cli_exit            \ Probably can't happen but might as well check
  640   Cmp #ASC(" ")
  650   Bne help_compare        \ if have non-space char, compare strings
  660   Inc user
  670   Bne help_skip_spaces
  680   Inc user+1
  690   Bne help_skip_spaces    \ always true
  700\
  710.help_compare
  720   Jsr compare_str         \ compare next word in user stream with keywords
  730   Bcs cli_exit            \ carry set = no match
  740   Jsr execute_comm        \ Having found the command, now execute it
  750   Clc                      \ Clear carry to tell caller command found
  760.cli_exit
  770   Pla                     \ restore parameter pointer
  780   Sta user+1
  790   Pla
  800   Sta user
  810\
  820   Rts
  830\
  840.ParamHandler
  850  Ldy #0
  860  Lda (user),Y
  870  Cmp #&0D
  880  Bne Param_exit_bar:Jmp Param_exit:.Param_exit_bar
  890  Cmp #ASC(" ")
  900  Bne Param_compare
  910  Inc user:Bne p_inc:inc user+1:.p_inc
  920  Bra ParamHandler
  930 
  940.Param_compare
  950  Jsr compare_param_str
  960  Bcs param_not_found:Jmp param_found:.param_not_found
  970  PHY
  980  OPT FNbreakno(&BA)
  990  OPT FNbreakstring("Error: parameter """)
 1000  Ply:Phy
 1010.spskip
 1020  Lda (user),Y
 1030  Cmp #&0D:Bne chksp:Jmp false_alarm:.chksp
 1040  Cmp #32:Bne errparm
 1050  Iny
 1060  Bra spskip
 1070.errparm
 1080  Lda (user),Y:Iny
 1090  Cmp #33:Bcc end_err_mess
 1100  Sta (table):Inc table:Bne P%+4:Inc table+1
 1110  Bra errparm
 1120.end_err_mess
 1130  OPT FNbreakstring(""" not recognised")
 1140  OPT FNdobreak \ Never returns, but if it did you should ...
 1150.false_alarm
 1160  PLY
 1170  Bra param_find_terminator
 1180.param_found
 1190  Jsr SetParamFlag
 1200  Ldy #0
 1210.param_find_terminator
 1220  Lda (user),Y
 1230  Cmp #&0D
 1240  Beq Param_exit
 1250  Cmp #ASC(" ")
 1260  Beq param_synchronise
 1270  Cmp #ASC(".")
 1280  Beq param_synchronise
 1290  Iny
 1300  Bra param_find_terminator
 1310 
 1320.param_synchronise
 1330  Iny
 1340  Jsr add_offset
 1350  Jmp Param_compare
 1360 
 1370.Param_exit
 1380 
 1390 
 1400 
 1410 
 1420 
 1430 
 1440\
 1450\****************************
 1460\*
 1470\*  add_offset
 1480\*
 1490\*  adds Y to user,user+1
 1500\*  to slide the user stream
 1510\*  under the window (Y)
 1520\*
 1530\****************************
 1540\
 1550.add_offset
 1560   Tya
 1570   Clc
 1580   Adc user               \ add Y to base value to give indexing with Y=0
 1590   Sta user                \ Y then has a common starting point for
 1600   Bcc add_exit              \ string comparison
 1610   Inc user+1
 1620.add_exit
 1630   Rts
 1640\
 1650\
 1660\*********************************
 1670\*
 1680\*   compare_str
 1690\*
 1700\*   compares a word in the user
 1710\*   stream with keyword table
 1720\*   stream
 1730\*
 1740\*   On entry, the streams are
 1750\*   synchronised. i.e. Y=0
 1760\*   windows the first char. in
 1770\*   each
 1780\*   Abbreviations are recognised.
 1790\*   On exit,
 1800\*     Carry clear  = match
 1810\*     Carry set    = no match
 1820\*     user,user+1 point to last
 1830\*     char. in word and Y=0
 1840\*
 1850\*********************************
 1860\
 1870\ (compare_param_str is a similar procedure for parameter strings)
 1880\
 1890.compare_param_str
 1900   Lda #param_table MOD &100
 1910   Sta table              \ pointer to parameter table
 1920   Lda #param_table DIV &100
 1930   Sta table+1
 1940   Ldx #NumParams
 1950   Bra compare_loop       \ merge two procedure bodies
 1960 
 1970.compare_str
 1980   Lda #help_table MOD &100
 1990   Sta table              \ pointer to keyword table
 2000   Lda #help_table DIV &100
 2010   Sta table+1
 2020   Ldx #NumCommands       \ count table entries
 2030\
 2040.compare_loop
 2050   Ldy #&FF               \ initialise window to strings
 2060.compare_chars
 2070   Iny                    \ window next pair of chars. - Y always < 255
 2080   Lda (user),Y           \ get next char. in user stream
 2090   Cmp #ASC(".")          \ abbreviation match?
 2100   Beq compare_skip       \ yes. get pointer to display page
 2110   Cmp (table),Y          \ no. compare with table stream
 2120   Beq compare_end
 2130   Sec                    \ no match. lower case?
 2140   Sbc #&20               \ lower to upper case displacement
 2150   Cmp (table),Y          \ try again
 2160   Beq compare_end
 2170   Cmp #ASC(" ")-&20      \ char mismatch. space vs. return?
 2180   Bne compare_table      \ no. strings don't match
 2190   Lda (table),Y          \ yes. see if table stream is <return>
 2200   Cmp #&0D
 2210   Beq compare_skip       \ exact match
 2220\
 2230.compare_table            \ no match
 2240   Cpx #1                 \ more table entries to try?
 2250   Beq compare_synchronise \ no.
 2260   Dex                    \ yes. get next entry
 2270   Lda #12                \ advance pointer to next table entry
 2280   Jsr advance_pointer
 2290   Jmp compare_loop
 2300\
 2310.compare_end
 2320   Cmp #&0D               \ end of both strings?
 2330   Bne compare_chars      \ no. keep comparing streams
 2340.compare_skip             \ match
 2350   Jsr add_offset         \ point to terminator or dot in user stream
 2360   Lda #MaxComLen+2       \ point to display data pointer
 2370   Jsr advance_pointer
 2380   Ldy #0                 \ reset window
 2390   Lda (table),Y          \ low byte of data pointer
 2400   Pha
 2410   Iny
 2420   Lda (table),Y          \ high byte
 2430   Sta table+1
 2440   Pla
 2450   Sta table
 2460   Clc                    \ indicate string match
 2470   Bcc compare_exit       \ exit with carry flag and pointer
 2480\
 2490.compare_synchronise
 2500   Jsr add_offset         \ point to terminator
 2510   Sec                    \ indicate no match
 2520\
 2530.compare_exit
 2540   Ldy #0                 \ exit pointing to current char. in user stream
 2550   Rts                    \ and with carry flag (clear=match)
 2560\
 2570\
 2580\******************************
 2590\*
 2600\*   advance_pointer
 2610\*
 2620\*   add A to table,table+1
 2630\*   to get table entries etc.
 2640\*
 2650\******************************
 2660\
 2670.advance_pointer
 2680   Clc
 2690   Adc table
 2700   Sta table
 2710   Bcc advance_exit
 2720   Inc table+1
 2730.advance_exit
 2740   Rts
 2750\
 2760\
 2770\**********************************
 2780\*
 2790\*   execute_comm
 2800\*
 2810\*   executes the code pointed to by
 2820\*   the entry now in (table)
 2830\*
 2840\**********************************
 2850\
 2860.execute_comm
 2870  Jmp (table)     \ ************ Execute command
 2880\
 2890\
 2900\  -----  KEYWORD TABLE AND DISPLAY DATA
 2910\
 2920.help_subheadings
 2930  EQUS "  "             \ embedded spaces for summary display
 2940.help_table
 2950  OPT FNTable("ARABIC", cli_arabic)
 2960  OPT FNTable("SCRNFLIP", cli_screenflip)
 2970  OPT FNTable("FLIPSCRN", cli_screenflip)
 2980  OPT FNTable("FONTFLIP", cli_fontflip)
 2990  OPT FNTable("FLIPFONT", cli_fontflip)
 3000  OPT FNTable("TEXTFLIP", cli_textflip)
 3010  OPT FNTable("FLIPTEXT", cli_textflip)
 3020 
 3030  OPT FNTable("COUNTRY", cli_country)
 3040  OPT FNTable("ALPHABET", cli_alphabet)
 3050  OPT FNTable("KEYBOARD", cli_keyboard)
 3060 
 3070.param_table
 3080  OPT FNTable("DEFAULT", 0)
 3090  OPT FNTable("UK", 1)
 3100  OPT FNTable("MASTER", 2)
 3110  OPT FNTable("COMPACT", 3)
 3120  OPT FNTable("SPAIN", 5)
 3130  OPT FNTable("GERMANY", 7)
 3140  OPT FNTable("ESPERANT", 9)
 3150  OPT FNTable("SWEDEN", 11)
 3160  OPT FNTable("FINLAND", 12)
 3170  OPT FNTable("DENMARK", 14)
 3180  OPT FNTable("NORWAY", 15)
 3190  OPT FNTable("ARABIC", 21)
 3200 
 3210  OPT FNTable("TEXT", Param_Text)
 3220  OPT FNTable("NUMERALS", Param_Numerals)
 3230  OPT FNTable("OFF", Param_Off)
 3240  OPT FNTable("ON", Param_On)
 3250  OPT FNTable("PRINTER", Param_Printer)
 3260  OPT FNTable("NORMAL", Param_Normal)
 3270  OPT FNTable("WIDE", Param_Wide)
 3280 
 3290  OPT FNTable("LATIN1", Alphabet_Latin1)
 3300  OPT FNTable("LATIN2", Alphabet_Latin2)
 3310  OPT FNTable("LATIN3", Alphabet_Latin3)
 3320  OPT FNTable("LATIN4", Alphabet_Latin4)
 3330  OPT FNTable("BFONT", Alphabet_BFont)
 3340 
 3350 
 3360 
 3370.cli_arabic  OPT FNEnter     \ <text|numerals> <off|on> | printer <off|on|narrow|wide>
 3380  Lda #ParamList:OPT FNSta(ParamIndex):Jsr ParamHandler
 3390  OPT FNLda(ParamIndex): Cmp #ParamList:Bne qq777:Jsr cli_arabic_noparam:Jmp cli_arabic_exit:.qq777
 3400  OPT FNLda(ParamList):Cmp #1:Beq qq1:Jsr cli_country_not_allowed:Jmp cli_country_exit:.qq1
 3410  OPT FNLda(ParamList+1)
 3420  Cmp #Param_Text MOD 256:Bne qq2:Jsr cli_arabic_text:Jmp cli_arabic_exit:.qq2
 3430  Cmp #Param_Numerals MOD 256:Bne qq3:Jsr cli_arabic_numerals:Jmp cli_arabic_exit:.qq3
 3440  Cmp #Param_Printer MOD 256:Bne qq4:Jsr cli_arabic_printer:Jmp cli_arabic_exit:.qq4
 3450  OPT FNbreak(&BB, "Error: Syntax is *ARABIC <Text | Numerals | Printer>")
 3460  Rts
 3470.cli_arabic_noparam
 3480  OPT FNArabicOp(14):OPT FNArabicOp(18):OPT FNSucceeded
 3490  OPT FNbreak(&BC, "Warning: *ARABIC not implemented")
 3500.cli_country_not_allowed
 3510  OPT FNbreak(&BD, "Error: a COUNTRY name is not valid here")
 3520.cli_arabic_text
 3530  OPT FNLda(ParamIndex):Sec:Sbc #ParamList
 3540  Cmp #2:Bne qq5:Jmp cli_arabic_text_on:.qq5
 3550  Cmp #4:Bne cli_arabic_text_toomany
 3560  Jsr VetP2OnOff
 3570  Cmp #0: Bne qq8:Jmp cli_arabic_text_on:.qq8
 3580  Cmp #1: Bne qq7:Jmp cli_arabic_text_off:.qq7
 3590  OPT FNbreak(&BE, "Error: Syntax is *ARABIC TEXT [on | off]")
 3600.cli_arabic_text_toomany
 3610  OPT FNbreak(&D9, "Error: too many parameters for *ARABIC TEXT")
 3620.cli_arabic_numerals_toomany
 3630  OPT FNbreak(&BF, "Error: too many parameters for *ARABIC NUMERALS")
 3640.cli_arabic_text_on
 3650  OPT FNArabicOp(14):OPT FNSucceeded
 3660  OPT FNbreak(&C0, "Warning: *ARABIC TEXT ON not implemented")
 3670.cli_arabic_numerals_on
 3680  OPT FNArabicOp(18):OPT FNSucceeded
 3690  OPT FNbreak(&D5, "Warning: *ARABIC NUMERALS ON not implemented")
 3700.cli_arabic_text_off
 3710  OPT FNArabicOp(15):OPT FNSucceeded
 3720  OPT FNbreak(&C1, "Warning: *ARABIC TEXT OFF not implemented")
 3730.cli_arabic_numerals_off
 3740  OPT FNArabicOp(19):OPT FNSucceeded
 3750  OPT FNbreak(&D4, "Warning: *ARABIC NUMERALS OFF not implemented")
 3760.cli_arabic_numerals
 3770  OPT FNLda(ParamIndex):Sec:Sbc #ParamList
 3780  Cmp #2:Bne qq511:Jmp cli_arabic_numerals_on:.qq511
 3790  Cmp #4:Beq qq12:Jmp cli_arabic_numerals_toomany:.qq12
 3800  Jsr VetP2OnOff
 3810  Cmp #0: Bne qq811:Jmp cli_arabic_numerals_on:.qq811
 3820  Cmp #1: Bne qq711:Jmp cli_arabic_numerals_off:.qq711
 3830  OPT FNbreak(&C2, "Error: Syntax is *ARABIC NUMERALS [on | off]")
 3840.cli_arabic_printer
 3850  OPT FNbreak(&C3, "Warning: *ARABIC PRINTER not implemented")
 3860.cli_screenflip  OPT FNEnter \ "", "Arabic", "UK"
 3870  Jsr FlipParam
 3880  Cmp #0:Bne qq42:Jsr screenflip:Jmp cli_screenflip_exit:.qq42
 3890  Cmp #1:Bne ww99: Jsr screenflip_arabic:Jmp cli_screenflip_exit:.ww99
 3900  Cmp #2:Bne qq142:Jsr screenflip_uk:Jmp cli_screenflip_exit:.qq142
 3910  OPT FNbreak(&C4, "Error: Syntax is *SCRNFLIP < UK | Arabic >")
 3920.screenflip_arabic
 3930  OPT FNArabicOp(2):OPT FNSucceeded
 3940  OPT FNbreak(&C5, "Warning: *SCRNFLIP ARABIC not implemented")
 3950.screenflip_uk
 3960  OPT FNArabicOp(3):OPT FNSucceeded
 3970  OPT FNbreak(&C6, "Warning: *SCRNFLIP UK not implemented")
 3980.screenflip
 3990  OPT FNArabicOp(1):OPT FNSucceeded
 4000  OPT FNbreak(&C7, "Warning: *SCRNFLIP not implemented")
 4010\\\  Jsr FlipHandler\(A)  - parameter in AND
 4020  Rts
 4030.cli_fontflip    OPT FNEnter \ "", "Arabic", "UK"
 4040  Jsr FlipParam
 4050  Cmp #0:Bne ww88:Jsr fontflip:Jmp cli_fontflip_exit:.ww88
 4060  Cmp #1:Bne qq987:Jsr fontflip_arabic:Jmp cli_fontflip_exit:.qq987
 4070  Cmp #2:Bne qq14:Jsr fontflip_uk:Jmp cli_fontflip_exit:.qq14
 4080  OPT FNbreak(&C8, "Error: Syntax is *FONTFLIP < UK | Arabic >")
 4090  Rts
 4100.fontflip
 4110  OPT FNArabicOp(4):OPT FNSucceeded
 4120  OPT FNbreak(&C9, "Warning: *FONTFLIP not implemented")
 4130.fontflip_arabic
 4140  OPT FNArabicOp(6):OPT FNSucceeded
 4150  OPT FNbreak(&CA, "Warning: *FONTFLIP ARABIC not implemented")
 4160.fontflip_uk
 4170  OPT FNArabicOp(7):OPT FNSucceeded
 4180  OPT FNbreak(&CB, "Warning: *FONTFLIP UK not implemented")
 4190.cli_textflip    OPT FNEnter \ "", "Arabic", "UK"
 4200  Jsr FlipParam
 4210  Cmp #0:Bne ww77:Jsr textflip:Jmp cli_textflip_exit:.ww77
 4220  Cmp #1:Bne qq345:Jsr textflip_arabic:Jmp cli_textflip_exit:.qq345
 4230  Cmp #2:Bne qq141:Jsr textflip_uk:Jmp cli_textflip_exit:.qq141
 4240  OPT FNbreak(&CD, "Error: Syntax is *TEXTFLIP < UK | Arabic >")
 4250  Rts
 4260.textflip
 4270  OPT FNArabicOp(8):OPT FNSucceeded
 4280  OPT FNbreak(&CE, "Warning: *TEXTFLIP not implemented")
 4290.textflip_arabic
 4300  OPT FNArabicOp(10):OPT FNSucceeded
 4310  OPT FNbreak(&CF, "Warning: *TEXTFLIP ARABIC not implemented")
 4320.textflip_uk
 4330  OPT FNArabicOp(11):OPT FNSucceeded
 4340  OPT FNbreak(&D0, "Warning: *TEXTFLIP UK not implemented")
 4350 
 4360.VetP2OnOff
 4370  OPT FNLda(ParamIndex):Sec:Sbc #ParamList
 4380  Cmp #2:Beq Return_on
 4390  Cmp #4:Beq qq6:Jmp cli_arabic_text_toomany:.qq6
 4400  OPT FNLda(ParamList+2):Cmp #1:Beq qq9:Jmp cli_country_not_allowed:.qq9
 4410  OPT FNLda(ParamList+3)
 4420  Cmp #Param_On MOD 256:Beq Return_on
 4430  Cmp #Param_Off MOD 256:Beq Return_off
 4440  Lda #&FF:Rts
 4450.Return_on Lda #0:Rts
 4460.Return_off Lda #1:Rts
 4470 
 4480.FlipParam
 4490  \ Vet "", "ARABIC", "UK" and return 0, 1 & 2 respectively in A
 4500  Lda #ParamList:OPT FNSta(ParamIndex)
 4510  Jsr ParamHandler
 4520  OPT FNLda(ParamIndex):Sec:Sbc #ParamList
 4530  Cmp #0: Beq UkArabic_noparam
 4540  Cmp #4: Beq UkArabic_toomany
 4550  OPT FNLda(ParamList)
 4560  Cmp #0:Bne UkArabic_wrong
 4570  OPT FNLda(ParamList+1)
 4580  Cmp #21:Beq UkArabic_Arabic
 4590  Cmp #1:Beq UkArabic_UK
 4600.UkArabic_toomany
 4610.UkArabic_wrong
 4620  Lda #&FF
 4630  Rts
 4640 
 4650.UkArabic_Arabic Lda #1:Rts
 4660.UkArabic_UK Lda #2:Rts
 4670.UkArabic_noparam Lda #0:Rts
 4680 
 4690.SetParamFlag    \ Note all parameters received and let each command
 4700                 \ ask it its parameter was among them.  Any left over
 4710                 \ at the end OUGHT to be complained about!
 4720  Lda table:PHA:Lda table+1:PHA
 4730  OPT FNLda(ParamIndex):Tay
 4740  PLA:Sta (data),Y:Iny
 4750  PLA:Sta (data),Y:Iny
 4760  Tya:OPT FNSta(ParamIndex)
 4770  Rts
 4780 
 4790.PHEX
 4800  PHA
 4810  Lsr A:Lsr A:Lsr A:Lsr A
 4820  Jsr PN
 4830  PLA
 4840.PN
 4850  And #15
 4860  Cmp #10
 4870  Bcc zzz1
 4880  Adc #6
 4890.zzz1
 4900  Adc #ASC("0")
 4910  Jmp oswrch
 4920 
 4930 
 4940 
 4950 
 4960.cli_country     OPT FNEnter
 4970  Lda #ParamList:OPT FNSta(ParamIndex)  \ Pointer to next free slot
 4980  Jsr ParamHandler
 4990  OPT FNLda(ParamIndex)
 5000  Cmp #ParamList
 5010  Bne country_params_given
 5020  OPT FNbreak(&D1,"Error: Syntax is *COUNTRY <Country name>")
 5030.country_params_given
 5040  Sec:Sbc #ParamList
 5050  Cmp #2:Beq country_one_param
 5060  OPT FNbreak(&D2,"Error: too many parameters for *Country")
 5070.country_one_param
 5080  OPT FNLda(ParamList)
 5090  Cmp #0
 5100  Beq is_a_country
 5110  OPT FNbreak(&D3,"Error: parameter must be a COUNTRY name")
 5120.is_a_country
 5130  OPT FNLda(ParamList+1)
 5140  Tax
 5150  PHX
 5160  Lda #70   \ *COUNTRY osbyte (documented elsewhere as *FX 240 !!)
 5170  Ldy #0
 5180  Jsr OsByte \ Set *COUNTRY
 5190  PLX:PHX
 5200  Lda #71
 5210  Ldy #0
 5220  Jsr OsByte \ Explicitly set *Keyboard  (This will work when paul fixes his code)
 5230  PLA:Ora #128:Tax
 5240  Lda #71
 5250  Ldy #0
 5260  Jsr OsByte \ And Explicitly set *Alphabet
 5270  Jmp cli_country_exit
 5280 
 5290.cli_alphabet    OPT FNEnter
 5300  Lda #ParamList:OPT FNSta(ParamIndex)  \ Pointer to next free slot
 5310  Jsr ParamHandler
 5320  OPT FNLda(ParamIndex)
 5330  Cmp #ParamList
 5340  Bne alphabet_params_given
 5350  OPT FNbreak(&D6,"Error: Syntax is *ALPHABET <Alphabet name|Country name>")
 5360.alphabet_params_given
 5370  Sec:Sbc #ParamList
 5380  Cmp #2:Beq alphabet_one_param
 5390  OPT FNbreak(&D7,"Error: too many parameters for *Alphabet")
 5400.alphabet_one_param
 5410  OPT FNLda(ParamList)
 5420  Cmp #0
 5430  Beq is_an_alphabet
 5440  OPT FNbreak(&D8,"Error: parameter must be an ALPHABET name")
 5450.is_an_alphabet
 5460  OPT FNLda(ParamList+1)
 5470  Tax
 5480  Lda #71   \ *ALPHABET/*KEYBOARD osbyte
 5490  Ldy #0
 5500  Jsr OsByte
 5510  Jmp cli_alphabet_exit
 5520  Rts
 5530 
 5540.cli_keyboard    OPT FNEnter
 5550  Lda #ParamList:OPT FNSta(ParamIndex)  \ Pointer to next free slot
 5560  Jsr ParamHandler
 5570  OPT FNLda(ParamIndex)
 5580  Cmp #ParamList
 5590  Bne keyboard_params_given
 5600  OPT FNbreak(&D9,"Error: Syntax is *Keyboard <Country name>")
 5610.keyboard_params_given
 5620  Sec:Sbc #ParamList
 5630  Cmp #2:Beq keyboard_one_param
 5640  OPT FNbreak(&D7,"Error: too many parameters for *Keyboard")
 5650.keyboard_one_param
 5660  OPT FNLda(ParamList)
 5670  Cmp #0
 5680  Beq is_a_keyboard
 5690  OPT FNbreak(&D8,"Error: parameter must be a COUNTRY name")
 5700.is_a_keyboard
 5710  OPT FNLda(ParamList+1)
 5720  Ora #128:Tax  \ Set top bit for *KEYBOARD osbyte
 5730  Lda #71   \ *ALPHABET/*KEYBOARD osbyte
 5740  Ldy #0
 5750  Jsr OsByte
 5760  Jmp cli_keyboard_exit
 5770  Rts
 5780 
 5790.cli_screenflip_exit  OPT FNExit:Rts
 5800.cli_fontflip_exit    OPT FNExit:Rts
 5810.cli_textflip_exit    OPT FNExit:Rts
 5820.cli_country_exit     OPT FNExit:Rts
 5830.cli_alphabet_exit    OPT FNExit:Rts
 5840.cli_keyboard_exit    OPT FNExit:Rts
 5850.cli_arabic_exit      OPT FNExit:Rts
 5860]
 5870NEXT Pass
 5880OSCLI("SAVE $.Arabic.Object.CLIOBJ "+STR$~(Q%)+" "+STR$~(O%)+" "+STR$~(R%-&8000+&3000)+" "+STR$~(R%-&8000+&3000))
 5890B%=CommandHandler
 5900CHAIN"$.Arabic.Source.Help"
 5910 
 5920DEFFNbreak(Num, Mess$)
 5930[OPT Pass
 5940  Bra P%+LEN(Mess$)+2+1+1+1
 5950.anylabel
 5960  BRK:EQUB Num:EQUS Mess$:EQUB 0
 5970.calculated_branch
 5980  Lda #anylabel MOD 256:Sta table
 5990  Lda #anylabel DIV 256:Sta table+1
 6000  Ldy #0
 6010.copyerr
 6020  Lda (table),Y
 6030  Sta &100,Y
 6040  Iny
 6050  Cpy #calculated_branch-anylabel
 6060  Bne copyerr
 6070  Jsr &100 \ Return address for possible debug help later
 6080]
 6090=Pass
 6100 
 6110DEFFNprintstring(Mess$)
 6120[OPT Pass
 6130  Bra P%+LEN(Mess$)+2
 6140.anylabel
 6150  EQUS Mess$
 6160.calculated_branch
 6170  Lda #anylabel MOD 256:Sta table
 6180  Lda #anylabel DIV 256:Sta table+1
 6190  Ldy #0
 6200.copyerr
 6210  Lda (table),Y
 6220  Jsr oswrch
 6230  Iny
 6240  Cpy #calculated_branch-anylabel
 6250  Bne copyerr
 6260]
 6270=Pass
 6280 
 6290DEFFNTable(Name$, Val)
 6300LOCAL name:DIM name 15:name!0=&0D0D0D0D:name!4=&0D0D0D0D:$name=Name$
 6310[OPT Pass
 6320  EQUD name!0
 6330  EQUD name!4
 6340  EQUB 13
 6350  EQUB text_terminator
 6360  EQUW Val
 6370]
 6380=Pass
 6390 
 6400DEFFNRelocate(from, to, ram)
 6410IF (ram+to-from)>=&100 THEN =FNLongRelocate(from, to, ram)
 6420[OPT Pass
 6430  Ldx #0:Ldy #ram   \ Y is pointer, X is counter
 6440.copy
 6450  Lda from,X: Sta (data),Y
 6460  Iny
 6470  Inx:Cpx #to-from:Bne copy
 6480]
 6490=Pass
 6500 
 6510DEFFNAddr(offset)
 6520IF offset >= &100 THEN =FNLongAddr(offset)
 6530[OPT Pass
 6540  PHP:PHA:Ldx &F4:Lda &DF0,X:Tay:Ldx #offset:PLA:PLP
 6550]
 6560=Pass
 6570 
 6580DEFFNJmp(offset)  : REM Jumps to private ram - absolute NOT indirect.
 6590IF offset >= &100 THEN =FNLongJmp(offset)
 6600[OPT Pass
 6610  PHP:PHA:PHX
 6620  Ldx &F4:Lda &DF0,X:Sta very_temp+1:Lda #offset:Sta very_temp
 6630  PLX:PLA:PLP
 6640  Jmp (very_temp)
 6650]
 6660=Pass
 6670 
 6680DEFFNJmpI(offset)  : REM Jumps VIA private ram - indirect.
 6690IF offset >= &100 THEN =FNLongJmpI(offset)
 6700[OPT Pass
 6710  PHP:PHA:PHX
 6720  Ldx &F4:Lda &DF0,X:Sta very_temp+1:Lda #offset:Sta very_temp
 6730  Lda (very_temp):Pha:Inc very_temp:Bne P%+4:Inc very_temp+1
 6740 
 6750 
 6760 
 6770 
 6780 
 6790 
 6800  Lda (very_temp):Sta very_temp+1:Pla:Sta very_temp
 6810  PLX:PLA:PLP
 6820  Jmp (very_temp)
 6830]
 6840=Pass
 6850 
 6860DEFPROCConsts
 6870                                  REM MyXXX's are initialised here for
 6880                                  REM 2-pass assembly in Basic.
 6890Ins = 21   : InsV = FNVector(Ins)
 6900OsByte = &FFF4
 6910Byte = 5   : ByteV = FNVector(Byte)
 6920OsWord = &FFF1
 6930OsCli  = &FFF7
 6940OsRdCh = &FFE0
 6950RdCh = 8   : RdChV = FNVector(RdCh)
 6960OsRdSc = &FFB9
 6970OsWrCh = &FFEE
 6980OsNewl = &FFE7
 6990OsAscii = &FFE3
 7000OsWrSc = &FFB3
 7010OsFind = &FFCE
 7020OsFile = &FFDD
 7030OsArgs = &FFDA
 7040OsGbPb = &FFD1
 7050OsBPut = &FFD4
 7060OsBGet = &FFD7
 7070OsEvent = &FFBF
 7080GSInit = &FFC2
 7090GSRead = &FFC5
 7100ENDPROC
 7110 
 7120DEFFNVector(N)
 7130 = &200 + 2*N
 7140 
 7150DEFPROCVars
 7160  ParamIndex = FNRmb(1)
 7170  ParamList = FNRmb(10)
 7180ENDPROC
 7190 
 7200DEFFNzp(N)
 7210LOCAL I
 7220  I = N%
 7230  N% = N% + N
 7240  IF N% > Z% THEN PRINT"ERROR: Using too much zero page.":END
 7250  = I
 7260 
 7270DEFFNRmb(N)
 7280LOCAL I
 7290  I = M%
 7300  M% = M% + N
 7310  = I
 7320 
 7330DEFFNEnter   : REM Called once on entry to Rom
 7340               REM Sets uplocal data area for easy access
 7350[OPT Pass
 7360  Lda data:PHA
 7370  Lda data+1:PHA
 7380  Phx:Ldx &F4:Lda &DF0,X:Plx
 7390  Sta data+1
 7400  Stz data
 7410]
 7420=Pass
 7430 
 7440DEFFNLda(variable_offset)
 7450[OPT Pass
 7460  Ldy #variable_offset:Lda (data),Y
 7470]
 7480=Pass
 7490 
 7500DEFFNSta(variable_offset)
 7510[OPT Pass
 7520  Ldy #variable_offset:Sta (data),Y
 7530]
 7540=Pass
 7550 
 7560DEFFNExit :REM Called once on exit from Rom
 7570[OPT Pass
 7580  Pla: Sta data+1
 7590  Pla: Sta data
 7600]
 7610=Pass
 7620DEFFNbreakno(Num)
 7630[OPT Pass
 7640  Lda #0:Sta table:Lda #1:Sta table+1
 7650  Lda #0:Sta (table):Inc table:Bne P%+4:Inc table+1
 7660  Lda #Num:Sta (table):Inc table:Bne P%+4:Inc table+1
 7670]
 7680=Pass
 7690 
 7700DEFFNbreakstring(Str$)
 7710LOCAL s:DIM s LEN(Str$):$s=Str$
 7720FOR idx = 0 TO LEN(Str$)-1
 7730  [OPT Pass: Lda #(s?idx):Sta (table):Inc table:Bne P%+4:Inc table+1:]
 7740NEXT
 7750=Pass
 7760 
 7770DEFFNdobreak
 7780[OPT Pass
 7790  Lda #0:Sta (table)
 7800  Jsr &100 \ Return address for possible debug help later
 7810]
 7820=Pass
 7830 
 7840DEFFNArabicOp(YReg)
 7850[OPT Pass
 7860  Lda #70:Ldx #21:Ldy #YReg
 7870  Jsr OsByte
 7880]
 7890=Pass
 7900 
 7910DEFFNSucceeded
 7920[OPT Pass
 7930  Cmp #70:Beq P%+2+1:Rts
 7940]
 7950=Pass
