10 REM > BBCMOS
   20 REM BBC MOS Interface
   30 REM Within this library, all filenames are locally formatted
   40 ;
   50 DEFFNmos_args
   60 IF Y%=0:IF A%=0:=FNfs           :REM =FS
   70 IF (Y%AND-512) THEN
   80   CASE A% OF
   90     WHEN 0:!X%=0:=0             :REM =PTR#-1
  100     WHEN 2:!X%=255-ADVAL(-1):=0 :REM =EXT#-1, number in keyboard buffer
  110     WHEN 5:!X%=ADVAL(-1)=0:=0   :REM =EOF#-1, keyboard buffer empty?
  120   ENDCASE
  130 ENDIF
  140 IF Y% THEN
  150   CASE A% OF
  160     WHEN 0:!X%=PTR#Y%:=0        :REM =PTR
  170     WHEN 1:PTR#Y%=!X%:=0        :REM PTR=
  180     WHEN 2:!X%=EXT#Y%:=0        :REM =EXT
  190     WHEN 3:EXT#Y%=!X%:=0        :REM EXT=
  200     WHEN 4:!X%=EXT#Y%:=0        :REM =Alloc
  210     WHEN 5:!X%=EOF#Y%:=0        :REM =EOF
  220     WHEN 6:EXT#Y%=!X%:=0        :REM Alloc=
  230   ENDCASE
  240 ENDIF
  250 IF os%=6:IF PAGE>&8000:SYS "OS_Args",A%,Y%,!X% TO A%,Y%,!X%:=A%
  260 !X%=FNargs(A%,Y%,!X%)
  270 =A%                             :REM Unchanged=unsupported
  280 :
  290 DEFFNmos_bget
  300 IF Y%=0:=GET                                 :REM =BGET#0
  310 IF os%AND32:=((PTR#Y%=EXT#Y%)AND256)+BGET#Y% :REM =BGET#Y
  320 A%=USR&FFD7
  330 =((A%AND&1000000)DIV&10000)OR(A%AND&FF)
  340 :
  350 DEFFNmos_bput
  360 IF Y%=0:VDU A% ELSE BPUT#Y%,A%
  370 =A%
  380 :
  390 DEFFNmos_find
  400 IF A%=0:CLOSE#Y%:=A%
  410 IF (A%AND&C0)=&40:=FNf_openin($Y%)
  420 IF (A%AND&C0)=&80:=FNf_openout($Y%)
  430 IF (A%AND&C0)=&C0:=FNf_openup($Y%)
  440 =0
  450 :
  460 DEFFNmos_file
  470 IF A%=0 OR A%=&FF:=FNhost_file
  480 IF os%=6:SYS "OS_File",A%,Y%,X%!2,X%!6,X%!10,X%!14 TO A%,,X%!2,X%!6,X%!10,X%!14:=A%
  490 IF A%=5:X%!2=0:X%!6=0:X%!10=0:X%!14=0:A%=Y%:Y%=X%DIV256:=FNfile_info($A%)
  500 IF A%=6:PROCf_delete($Y%):=1
  510 IF A%=7:OSCLI"SAVE "+FNf_name($Y%)+" "+STR$~PAGE+"+"+STR$~(X%!14-X%!10):=1
  520 IF A%=8:PROCf_cdir($Y%):=2
  530 =A%
  540 :
  550 DEFFNmos_gbpb:=FNhost_gbpb
  560 :
  570 DEFFNmos_cli
  580 Y%=Y%-1:REPEAT:Y%=Y%+1:UNTIL?Y%<>32 AND ?Y%<>ASC"*"     :REM Skip '*'s and ' 's
  590 A%=&103:IF ?Y%=ASC"/":Y%=Y%+1:A%=&102                   :REM Fall through into FSC
  600 :
  610 DEFFNmos_fsc
  620 osc%=A%AND256:A%=A%AND255                               :REM b8=called from OSCLI
  630 CASE A% OF
  640   WHEN 1:A%=5:X%=ctrl%:A%=FNmos_args:X%=?X%:Y%=X%:=A%   :REM =EOF
  650   WHEN 3:                                               :REM *command
  660   IF ?Y%=ASC"|":=0                                    :REM *| comment
  670   IF ?Y%=ASC"\":Y%=Y%+1                               :REM *\command -> *command
  680   IF ?Y%=13:=0                                        :REM Null string
  690   A%=INSTR($Y%+" "," "):B%=INSTR($Y%,"."):IFB%:IFA%>B%+1:A%=B%+1
  700   A$=":"+FNuc(LEFT$($Y%,A%-1)):Y%=Y%+A%-1             :REM A$=command
  710   WHILE ?Y%=32:Y%=Y%+1:ENDWHILE                       :REM Skip spaces
  720   IF RIGHT$(A$,1)=".":A$=LEFT$(A$,LENA$-1) ELSE A$=A$+":"
  730   A%=INSTR(":CAT::::RUN::::CAT::::DELETE:CREATE:CDIR:::EX:::::INFO:::RENAME:",A$)
  740   IF A%=0:A%=3ORosc%:Y%=string%:=FNhost_fsc
  750   A%=3+A%DIV7:IF A%=3:A%=5
  760   IF A%>5 AND A%<9 THEN
  770     X%=Y%-1:REPEATX%=X%+1:UNTIL?X%<33:?X%=13          :REM Terminate string
  780     IF A%=7 THEN
  790       X%=X%-1:REPEAT:X%=X%+1:UNTIL?X%<>32             :REM *CREATE filename length
  800       ctrl%!14=EVAL("&"+$X%)
  810       ctrl%!2=0:ctrl%!6=0:ctrl%!10=0
  820     ENDIF
  830     $Y%=FNfn_convert($Y%,client%,host%):X%=ctrl%:!X%=Y%:=FNmos_file
  840   ENDIF
  850   A%=A%ORosc%
  860 ENDCASE
  870 =FNhost_fsc
  880 :
  890 DEFFNmos_word
  900 CASE A% OF
  910   WHEN 0:INPUT LINE""A$:$Y%=A$:X%=Y%:Y%=LENA$:=0
  920   WHEN 1:!X%=TIME:=0
  930   WHEN 2:TIME=!X%:=0
  940   WHEN 5:X%?4=?!X%:=0
  950   WHEN 6:?!X%=X%?4:=0
  960   WHEN 7:SOUND !X%,X%!2,X%!4,X%!6:=0
  970   WHEN 8:ENVELOPE X%?0,X%?1,X%?2,X%?3,X%?4,X%?5,X%?6,X%?7,X%?8,X%?9,X%?10,X%?11,X%?12,X%?13:=0
  980   WHEN 14:$X%=TIME$:=0
  990   WHEN 15:TIME$=$X%:=0
 1000 OTHERWISE
 1010   Y%=X%DIV256:A%=(USR&FFF1)AND&FF
 1020 ENDCASE
 1030 =A%
 1040 :
 1050 DEFFNmos_byte
 1060 IF A%=0 THEN
 1070   X%=(os%AND&D7)OR((client%AND64)DIV2)OR((client%AND32)DIV4)
 1080   IF X%<>os%:X%=X%OR&80
 1090   =0                                                    :REM =HOST
 1100 ENDIF
 1110 IF A%>123:IFA%<127:?escflg%=128*(A%AND1):OSCLI"FX15"    :REM Clear/Set/Ack Escape
 1120 IF A%=&7F:A%=5:X%=ctrl%:A%=FNmos_args:X%=?X%:Y%=X%:=&7F :REM =EOF
 1130 IF A%=&81:X%=INKEY((X%AND255)+256*Y%):Y%=X%DIV256:=A%+256*(X%=-1)  :REM =INKEY
 1140 IF A%=&82:X%=membot%DIV65536:Y%=X%DIV256:=A%            :REM high order address
 1150 IF A%=&83:X%=membot%:Y%=X%DIV256:=A%                    :REM bottom of memory
 1160 IF A%=&84:X%=memtop%:Y%=X%DIV256:=A%                    :REM top of memory
 1170 IF A%=&86:X%=POS:Y%=VPOS:=A%                            :REM =POS, =VPOS
 1180 IF os%=32 THEN
 1190   IF A%=&80:IFX%=7:MOUSE X%,A%,A%:Y%=X%DIV256:=&80      :REM =ADVAL(7)
 1200   IF A%=&80:IFX%=8:MOUSE A%,X%,A%:Y%=X%DIV256:=&80      :REM =ADVAL(8)
 1210   IF A%=&80:IFX%=9:MOUSE A%,A%,X%:Y%=X%DIV256:=&80      :REM =ADVAL(9)
 1220   IF A%=&87:X%=GET(POS,VPOS):Y%=MODE:=A%                :REM =MODE
 1230   IF A%=&A0 THEN
 1240     CASE X% OF
 1250       WHEN  0,128:SYS "GetRgnBox",@vdu%!60,ctrl%:X%=ctrl%!0
 1260       WHEN  2,129:SYS "GetRgnBox",@vdu%!60,ctrl%:X%=ctrl%!4
 1270       WHEN  4,130:SYS "GetRgnBox",@vdu%!60,ctrl%:X%=ctrl%!8
 1280       WHEN  6,131:SYS "GetRgnBox",@vdu%!60,ctrl%:X%=ctrl%!12
 1290       WHEN  8,132:X%=@vdu%!24 DIV @vdu%!216
 1300       WHEN  9,133:X%=@vdu%!36 DIV @vdu%!220-1
 1310       WHEN 10,134:X%=@vdu%!28 DIV @vdu%!216-1
 1320       WHEN 11,135:X%=@vdu%!32 DIV @vdu%!220
 1330       WHEN 12,136:X%=2*@vdu%!0
 1340       WHEN 14,137:X%=2*@vdu%!4
 1350       WHEN 16,138:X%=2*@vdu%!8
 1360       WHEN 18,139:SYS "GetRgnBox",@vdu%!60,ctrl%:X%=2*(ctrl%!12-@vdu%!12-1)
 1370       WHEN 20,142:X%=@vdu%!16
 1380       WHEN 22,143:SYS "GetRgnBox",@vdu%!60,ctrl%:X%=(ctrl%!12-@vdu%!20-1)
 1390       WHEN 36:X%=@vdu%!8
 1400       WHEN 38:SYS "GetRgnBox",@vdu%!60,ctrl%:X%=(ctrl%!12-@vdu%!12-1)
 1410       WHEN 87,155:X%=@vdu%?70
 1420       WHEN 88,156:X%=@vdu%?71
 1430       WHEN 89,153:X%=@vdu%?65
 1440       WHEN 90,154:X%=@vdu%?67
 1450       WHEN 91,151:X%=3-(@vdu%?64-7)DIV2:IFX%<0:X%=1
 1460       WHEN 92,152:X%=3-(@vdu%?66-7)DIV2:IFX%<0:X%=1
 1470       WHEN 96,3:X%=@vdu%?73
 1480     OTHERWISE
 1490       X%=0
 1500     ENDCASE
 1510     Y%=X%DIV256:=&A0
 1520   ENDIF
 1530 ENDIF
 1540 IF A%=&80:X%=ADVAL((X%AND255)+256*Y%):Y%=X%DIV256:=A% :REM =ADVAL
 1550 IF A%=&A0 THEN
 1560   IF X%<16:IF X%<>3:=A%                               :REM =VDU(n)
 1570   IF X%=3:X%=96
 1580   CASE r%(1) OF
 1590     WHEN 16:A%=138
 1600     WHEN 18:A%=139
 1610     WHEN 20:A%=142
 1620     WHEN 22:A%=143
 1630     WHEN 36:A%=144
 1640     WHEN 38:A%=145
 1650     WHEN 77:A%=148
 1660     WHEN 80:A%=149
 1670     WHEN 83:A%=150
 1680     WHEN 87:A%=155
 1690     WHEN 88:A%=156
 1700     WHEN 89:A%=153
 1710     WHEN 90:A%=154
 1720     WHEN 91:A%=151
 1730     WHEN 92:A%=152
 1740     WHEN 96:A%=3
 1750   OTHERWISE
 1760     A%=X%:IF A%<128:X%=0:Y%=0:=&A0
 1770   ENDCASE
 1780   !ctrl%=A%:ctrl%!4=-1:SYS "OS_ReadVduVariables",ctrl%,ctrl%+8
 1790   X%=ctrl%!8:Y%=X%DIV256:=&A0
 1800 ENDIF
 1810 A%=USR&FFF4:X%=(A%AND&FFFF00)DIV256:Y%=(A%AND&FF0000)DIV65536
 1820 =(A%AND&1000000)DIV&10000+(A%AND&FF)
 1830 :

Download BBCMOS

BBC BASIC detokeniser and syntax highlighter by Ben Ryves.