Home » Personal collection » Acorn DFS disks » dfs_box04_disk06_pilot_one.scp » A.INTPROC

A.INTPROC

This website contains an archive of files for the Acorn Electron, BBC Micro, Acorn Archimedes, Commodore 16 and Commodore 64 computers, which Dominic Ford has rescued from his private collection of floppy disks and cassettes.

Some of these files were originally commercial releases in the 1980s and 1990s, but they are now widely available online. I assume that copyright over them is no longer being asserted. If you own the copyright and would like files to be removed, please contact me.

Tape/disk: Home » Personal collection » Acorn DFS disks » dfs_box04_disk06_pilot_one.scp
Filename: A.INTPROC
Read OK: ✔
File size: 0CCE bytes
Load address: FF1600
Exec address: FF8023
Duplicates

There is 1 duplicate copy of this file in the archive:

File contents
 9999 CLS:END
10000 REM ***USES OSBYTE/*FX150 TO EXAMINE VIA REGISTER. REQUIRES OFFSET OF REGISTER IN PAGE &FE AS PARAMETER.***
10010 DEF FNpeek(offset) 
10020 LOCAL value
10030 A%=150:X%=offset:value=(USR(&FFF4) AND &FF0000) DIV &10000 
10040 =value
11000 REM ***USES OSBYTE/*FX151 TO WRITE A VALUE TO A VIA REGISTER.  REQUIRES OFFSET OF REGISTER IN PAGE &FE, AND VALUE TO BE WRITTEN AS PARAMETERS.***
11010 DEF PROCpoke(offset,value)
11020 A%=151:X%=offset:Y%=value:CALL &FFF4 
11030 ENDPROC  
12000 REM ***EXAMINES THE CURRENT STATE OF THE RELAY SPECIFIED AND SWAPS IT OVER.***
12010 DEF PROCtoggle(linenumber) 
12020 IF (linenumber>3 OR linenumber<0) THEN *FX125 
12030 LOCAL bitvalue,oldvalue,newvalue
12040 bitvalue=2^linenumber
12050 oldvalue=FNpeek(&60)  
12060 newvalue=oldvalue EOR bitvalue
12070 PROCpoke(&60,newvalue)
12080 ENDPROC  
13000 REM ***TURNS ON OR OFF A SPECIFIED RELAY.  REQUIRES ACTION TO BE TAKEN ie. "ON" OR "OFF", AND RELAY NUMBER AS PARAMETERS***
13010 DEF PROCturn(onORoff$,linenumber)
13020 IF NOT(onORoff$="ON" OR onORoff$="OFF") THEN *FX125 
13030 IF (linenumber>3 OR linenumber<0) THEN *FX125 
13040 LOCAL bitvalue,oldvalue,newvalue
13050 bitvalue=2^linenumber
13060 oldvalue=FNpeek(&60) 
13070 IF onORoff$="ON" THEN newvalue=oldvalue OR bitvalue ELSE newvalue=oldvalue AND (255-bitvalue)
13080 PROCpoke(&60,newvalue)
13090 ENDPROC
14000 REM ***TESTS THE CURRENT STATE OF THE SPECIFIED INPUT (4-7) AND RETURNS THE VALUE "ON" OR "OFF".***
14010 DEF FNtest(linenumber) 
14020 IF (linenumber>7 OR linenumber<4) THEN *FX125  
14030 LOCAL bitvalue
14040 bitvalue=2^linenumber
14050 result=((FNpeek(&60) AND bitvalue)=bitvalue)
14060 IF result THEN ="ON" ELSE ="OFF"
15000 REM ***TESTS THE STATE OF THE SPECIFIED RELAYS IN TURN AND SWAPS THEM. REQUIRES A STRING REPRESENTING THE RELAYS TO BE TOGGLED AS A BINARY PATTERN.***
15010 DEF PROCmultitoggle(pattern$) 
15020 LOCAL L,L$,mask%,oldvalue,newvalue
15030 IF LEN(pattern$)<>4 THEN *FX125
15040 FOR L=1 TO 4:L$=MID$(pattern$,L,1):IF NOT(L$="1" OR L$="0") THEN *FX125
15050 NEXT
15060 mask%=0:FOR L=1 TO 4:IF (MID$(pattern$,L,1)="1") THEN mask%=mask%+2^(4-L)  
15070 NEXT
15080 oldvalue=FNpeek(&60):newvalue=oldvalue EOR mask%
15090 PROCpoke(&60,newvalue)
15100 ENDPROC
16000 REM ***TURNS ON OR OFF THE SPECIFIED GROUP OF RELAYS.  REQUIRES TWO PARAMETERS:-(i)THE ACTION TO BE TAKEN ie."ON" OR "OFF", (ii)A STRING REPRESENTING THE RELAYS TO BE SWITCHED AS A BINARY PATTERN.***
16010 DEF PROCmultiturn(onORoff$,pattern$)
16020 LOCAL L,L$,mask%,oldvalue,newvalue
16030 IF LEN(pattern$)<>4 OR NOT(onORoff$="ON" OR onORoff$="OFF") THEN *FX125
16040 FOR L=1 TO 4:L$=MID$(pattern$,L,1):IF NOT(L$="1" OR L$="0") THEN *FX125
16050 NEXT
16060 mask%=0:FOR L=1 TO 4:IF (MID$(pattern$,L,1)="1") THEN mask%=mask%+2^(4-L)  
16070 NEXT
16080 oldvalue=FNpeek(&60):IF onORoff$="ON" THEN newvalue=oldvalue OR mask% ELSE newvalue=oldvalue AND (255-mask%)
16090 PROCpoke(&60,newvalue)
16100 ENDPROC
17000 REM ***TESTS THE SPECIFIED GROUP OF INPUTS AND RETURNS THE VALUE "ON" IF ALL OF THEM ARE ON AND "OFF" IF ANY ONE OF THEM IS OFF.  REQUIRES A STRING REPRESENTING THE INPUTS TO BE TESTED AS A BINARY PATTERN.***
17010 DEF FNmultitest(pattern$) 
17020 LOCAL L,L$,testmask%,result
17030 IF LEN(pattern$)<>4 THEN *FX125
17040 FOR L=1 TO 4:L$=MID$(pattern$,L,1):IF NOT(L$="1" OR L$="0") THEN *FX125
17050 NEXT
17060 testmask%=0:FOR L=1 TO 4:IF (MID$(pattern$,L,1)="1") THEN testmask%=testmask%+2^(8-L) 
17070 NEXT
17080 result=((FNpeek(&60) AND testmask%)=testmask%) 
17090 IF result THEN ="ON" ELSE ="OFF"
18000 REM ***INITIALISES USER PORT AS FOUR OUTPUTS ON PB0-3 AND FOUR INPUTS ON PB4-7. TURNS ALL OUTPUTS OFF.***
18010 DEF PROCset_up_port
18020 PROCpoke(&62,15)
18030 PROCpoke(&60,0)
18040 ENDPROC

' �:�
'n � ***USES OSBYTE/*FX150 TO EXAMINE VIA REGISTER. REQUIRES OFFSET OF REGISTER IN PAGE &FE AS PARAMETER.***
' � �peek(offset) 
'$ � value
'.: A%=150:X%=offset:value=(�(&FFF4) � &FF0000) � &10000 
'8 =value
*�� � ***USES OSBYTE/*FX151 TO WRITE A VALUE TO A VIA REGISTER.  REQUIRES OFFSET OF REGISTER IN PAGE &FE, AND VALUE TO BE WRITTEN AS PARAMETERS.***
+ � �poke(offset,value)
+' A%=151:X%=offset:Y%=value:� &FFF4 
+ �  
.�Q � ***EXAMINES THE CURRENT STATE OF THE RELAY SPECIFIED AND SWAPS IT OVER.***
.� � �toggle(linenumber) 
.�. � (linenumber>3 � linenumber<0) � *FX125 
.�! � bitvalue,oldvalue,newvalue
/ bitvalue=2^linenumber
/ oldvalue=�peek(&60)  
/! newvalue=oldvalue � bitvalue
/& �poke(&60,newvalue)
/0 �  
2�~ � ***TURNS ON OR OFF A SPECIFIED RELAY.  REQUIRES ACTION TO BE TAKEN ie. "ON" OR "OFF", AND RELAY NUMBER AS PARAMETERS***
2�! � �turn(onORoff$,linenumber)
2�2 � �(onORoff$="ON" � onORoff$="OFF") � *FX125 
2�. � (linenumber>3 � linenumber<0) � *FX125 
2�! � bitvalue,oldvalue,newvalue
2� bitvalue=2^linenumber
3 oldvalue=�peek(&60) 
3X � onORoff$="ON" � newvalue=oldvalue � bitvalue � newvalue=oldvalue � (255-bitvalue)
3 �poke(&60,newvalue)
3" �
6�f � ***TESTS THE CURRENT STATE OF THE SPECIFIED INPUT (4-7) AND RETURNS THE VALUE "ON" OR "OFF".***
6� � �test(linenumber) 
6�/ � (linenumber>7 � linenumber<4) � *FX125  
6� � bitvalue
6� bitvalue=2^linenumber
6�. result=((�peek(&60) � bitvalue)=bitvalue)
6� � result � ="ON" � ="OFF"
:�� � ***TESTS THE STATE OF THE SPECIFIED RELAYS IN TURN AND SWAPS THEM. REQUIRES A STRING REPRESENTING THE RELAYS TO BE TOGGLED AS A BINARY PATTERN.***
:� � �multitoggle(pattern$) 
:�# � L,L$,mask%,oldvalue,newvalue
:� � �(pattern$)<>4 � *FX125
:�> � L=1 � 4:L$=�pattern$,L,1):� �(L$="1" � L$="0") � *FX125
:� �
:�E mask%=0:� L=1 � 4:� (�pattern$,L,1)="1") � mask%=mask%+2^(4-L)  
:� �
:�2 oldvalue=�peek(&60):newvalue=oldvalue � mask%
:� �poke(&60,newvalue)
:� �
>�� � ***TURNS ON OR OFF THE SPECIFIED GROUP OF RELAYS.  REQUIRES TWO PARAMETERS:-(i)THE ACTION TO BE TAKEN ie."ON" OR "OFF", (ii)A STRING REPRESENTING THE RELAYS TO BE SWITCHED AS A BINARY PATTERN.***
>�$ � �multiturn(onORoff$,pattern$)
>�# � L,L$,mask%,oldvalue,newvalue
>�B � �(pattern$)<>4 � �(onORoff$="ON" � onORoff$="OFF") � *FX125
>�> � L=1 � 4:L$=�pattern$,L,1):� �(L$="1" � L$="0") � *FX125
>� �
>�E mask%=0:� L=1 � 4:� (�pattern$,L,1)="1") � mask%=mask%+2^(4-L)  
>� �
>�f oldvalue=�peek(&60):� onORoff$="ON" � newvalue=oldvalue � mask% � newvalue=oldvalue � (255-mask%)
>� �poke(&60,newvalue)
>� �
Bh� � ***TESTS THE SPECIFIED GROUP OF INPUTS AND RETURNS THE VALUE "ON" IF ALL OF THEM ARE ON AND "OFF" IF ANY ONE OF THEM IS OFF.  REQUIRES A STRING REPRESENTING THE INPUTS TO BE TESTED AS A BINARY PATTERN.***
Br � �multitest(pattern$) 
B| � L,L$,testmask%,result
B� � �(pattern$)<>4 � *FX125
B�> � L=1 � 4:L$=�pattern$,L,1):� �(L$="1" � L$="0") � *FX125
B� �
B�P testmask%=0:� L=1 � 4:� (�pattern$,L,1)="1") � testmask%=testmask%+2^(8-L) 
B� �
B�1 result=((�peek(&60) � testmask%)=testmask%) 
B� � result � ="ON" � ="OFF"
FPl � ***INITIALISES USER PORT AS FOUR OUTPUTS ON PB0-3 AND FOUR INPUTS ON PB4-7. TURNS ALL OUTPUTS OFF.***
FZ � �set_up_port
Fd �poke(&62,15)
Fn �poke(&60,0)
Fx �
�
00000000  0d 27 0f 08 20 db 3a e0  0d 27 10 6e 20 f4 20 2a  |.'.. .:..'.n . *|
00000010  2a 2a 55 53 45 53 20 4f  53 42 59 54 45 2f 2a 46  |**USES OSBYTE/*F|
00000020  58 31 35 30 20 54 4f 20  45 58 41 4d 49 4e 45 20  |X150 TO EXAMINE |
00000030  56 49 41 20 52 45 47 49  53 54 45 52 2e 20 52 45  |VIA REGISTER. RE|
00000040  51 55 49 52 45 53 20 4f  46 46 53 45 54 20 4f 46  |QUIRES OFFSET OF|
00000050  20 52 45 47 49 53 54 45  52 20 49 4e 20 50 41 47  | REGISTER IN PAG|
00000060  45 20 26 46 45 20 41 53  20 50 41 52 41 4d 45 54  |E &FE AS PARAMET|
00000070  45 52 2e 2a 2a 2a 0d 27  1a 15 20 dd 20 a4 70 65  |ER.***.'.. . .pe|
00000080  65 6b 28 6f 66 66 73 65  74 29 20 0d 27 24 0c 20  |ek(offset) .'$. |
00000090  ea 20 76 61 6c 75 65 0d  27 2e 3a 20 41 25 3d 31  |. value.'.: A%=1|
000000a0  35 30 3a 58 25 3d 6f 66  66 73 65 74 3a 76 61 6c  |50:X%=offset:val|
000000b0  75 65 3d 28 ba 28 26 46  46 46 34 29 20 80 20 26  |ue=(.(&FFF4) . &|
000000c0  46 46 30 30 30 30 29 20  81 20 26 31 30 30 30 30  |FF0000) . &10000|
000000d0  20 0d 27 38 0b 20 3d 76  61 6c 75 65 0d 2a f8 94  | .'8. =value.*..|
000000e0  20 f4 20 2a 2a 2a 55 53  45 53 20 4f 53 42 59 54  | . ***USES OSBYT|
000000f0  45 2f 2a 46 58 31 35 31  20 54 4f 20 57 52 49 54  |E/*FX151 TO WRIT|
00000100  45 20 41 20 56 41 4c 55  45 20 54 4f 20 41 20 56  |E A VALUE TO A V|
00000110  49 41 20 52 45 47 49 53  54 45 52 2e 20 20 52 45  |IA REGISTER.  RE|
00000120  51 55 49 52 45 53 20 4f  46 46 53 45 54 20 4f 46  |QUIRES OFFSET OF|
00000130  20 52 45 47 49 53 54 45  52 20 49 4e 20 50 41 47  | REGISTER IN PAG|
00000140  45 20 26 46 45 2c 20 41  4e 44 20 56 41 4c 55 45  |E &FE, AND VALUE|
00000150  20 54 4f 20 42 45 20 57  52 49 54 54 45 4e 20 41  | TO BE WRITTEN A|
00000160  53 20 50 41 52 41 4d 45  54 45 52 53 2e 2a 2a 2a  |S PARAMETERS.***|
00000170  0d 2b 02 1a 20 dd 20 f2  70 6f 6b 65 28 6f 66 66  |.+.. . .poke(off|
00000180  73 65 74 2c 76 61 6c 75  65 29 0d 2b 0c 27 20 41  |set,value).+.' A|
00000190  25 3d 31 35 31 3a 58 25  3d 6f 66 66 73 65 74 3a  |%=151:X%=offset:|
000001a0  59 25 3d 76 61 6c 75 65  3a d6 20 26 46 46 46 34  |Y%=value:. &FFF4|
000001b0  20 0d 2b 16 08 20 e1 20  20 0d 2e e0 51 20 f4 20  | .+.. .  ...Q . |
000001c0  2a 2a 2a 45 58 41 4d 49  4e 45 53 20 54 48 45 20  |***EXAMINES THE |
000001d0  43 55 52 52 45 4e 54 20  53 54 41 54 45 20 4f 46  |CURRENT STATE OF|
000001e0  20 54 48 45 20 52 45 4c  41 59 20 53 50 45 43 49  | THE RELAY SPECI|
000001f0  46 49 45 44 20 41 4e 44  20 53 57 41 50 53 20 49  |FIED AND SWAPS I|
00000200  54 20 4f 56 45 52 2e 2a  2a 2a 0d 2e ea 1b 20 dd  |T OVER.***.... .|
00000210  20 f2 74 6f 67 67 6c 65  28 6c 69 6e 65 6e 75 6d  | .toggle(linenum|
00000220  62 65 72 29 20 0d 2e f4  2e 20 e7 20 28 6c 69 6e  |ber) .... . (lin|
00000230  65 6e 75 6d 62 65 72 3e  33 20 84 20 6c 69 6e 65  |enumber>3 . line|
00000240  6e 75 6d 62 65 72 3c 30  29 20 8c 20 2a 46 58 31  |number<0) . *FX1|
00000250  32 35 20 0d 2e fe 21 20  ea 20 62 69 74 76 61 6c  |25 ...! . bitval|
00000260  75 65 2c 6f 6c 64 76 61  6c 75 65 2c 6e 65 77 76  |ue,oldvalue,newv|
00000270  61 6c 75 65 0d 2f 08 1a  20 62 69 74 76 61 6c 75  |alue./.. bitvalu|
00000280  65 3d 32 5e 6c 69 6e 65  6e 75 6d 62 65 72 0d 2f  |e=2^linenumber./|
00000290  12 1a 20 6f 6c 64 76 61  6c 75 65 3d a4 70 65 65  |.. oldvalue=.pee|
000002a0  6b 28 26 36 30 29 20 20  0d 2f 1c 21 20 6e 65 77  |k(&60)  ./.! new|
000002b0  76 61 6c 75 65 3d 6f 6c  64 76 61 6c 75 65 20 82  |value=oldvalue .|
000002c0  20 62 69 74 76 61 6c 75  65 0d 2f 26 18 20 f2 70  | bitvalue./&. .p|
000002d0  6f 6b 65 28 26 36 30 2c  6e 65 77 76 61 6c 75 65  |oke(&60,newvalue|
000002e0  29 0d 2f 30 08 20 e1 20  20 0d 32 c8 7e 20 f4 20  |)./0. .  .2.~ . |
000002f0  2a 2a 2a 54 55 52 4e 53  20 4f 4e 20 4f 52 20 4f  |***TURNS ON OR O|
00000300  46 46 20 41 20 53 50 45  43 49 46 49 45 44 20 52  |FF A SPECIFIED R|
00000310  45 4c 41 59 2e 20 20 52  45 51 55 49 52 45 53 20  |ELAY.  REQUIRES |
00000320  41 43 54 49 4f 4e 20 54  4f 20 42 45 20 54 41 4b  |ACTION TO BE TAK|
00000330  45 4e 20 69 65 2e 20 22  4f 4e 22 20 4f 52 20 22  |EN ie. "ON" OR "|
00000340  4f 46 46 22 2c 20 41 4e  44 20 52 45 4c 41 59 20  |OFF", AND RELAY |
00000350  4e 55 4d 42 45 52 20 41  53 20 50 41 52 41 4d 45  |NUMBER AS PARAME|
00000360  54 45 52 53 2a 2a 2a 0d  32 d2 21 20 dd 20 f2 74  |TERS***.2.! . .t|
00000370  75 72 6e 28 6f 6e 4f 52  6f 66 66 24 2c 6c 69 6e  |urn(onORoff$,lin|
00000380  65 6e 75 6d 62 65 72 29  0d 32 dc 32 20 e7 20 ac  |enumber).2.2 . .|
00000390  28 6f 6e 4f 52 6f 66 66  24 3d 22 4f 4e 22 20 84  |(onORoff$="ON" .|
000003a0  20 6f 6e 4f 52 6f 66 66  24 3d 22 4f 46 46 22 29  | onORoff$="OFF")|
000003b0  20 8c 20 2a 46 58 31 32  35 20 0d 32 e6 2e 20 e7  | . *FX125 .2.. .|
000003c0  20 28 6c 69 6e 65 6e 75  6d 62 65 72 3e 33 20 84  | (linenumber>3 .|
000003d0  20 6c 69 6e 65 6e 75 6d  62 65 72 3c 30 29 20 8c  | linenumber<0) .|
000003e0  20 2a 46 58 31 32 35 20  0d 32 f0 21 20 ea 20 62  | *FX125 .2.! . b|
000003f0  69 74 76 61 6c 75 65 2c  6f 6c 64 76 61 6c 75 65  |itvalue,oldvalue|
00000400  2c 6e 65 77 76 61 6c 75  65 0d 32 fa 1a 20 62 69  |,newvalue.2.. bi|
00000410  74 76 61 6c 75 65 3d 32  5e 6c 69 6e 65 6e 75 6d  |tvalue=2^linenum|
00000420  62 65 72 0d 33 04 19 20  6f 6c 64 76 61 6c 75 65  |ber.3.. oldvalue|
00000430  3d a4 70 65 65 6b 28 26  36 30 29 20 0d 33 0e 58  |=.peek(&60) .3.X|
00000440  20 e7 20 6f 6e 4f 52 6f  66 66 24 3d 22 4f 4e 22  | . onORoff$="ON"|
00000450  20 8c 20 6e 65 77 76 61  6c 75 65 3d 6f 6c 64 76  | . newvalue=oldv|
00000460  61 6c 75 65 20 84 20 62  69 74 76 61 6c 75 65 20  |alue . bitvalue |
00000470  8b 20 6e 65 77 76 61 6c  75 65 3d 6f 6c 64 76 61  |. newvalue=oldva|
00000480  6c 75 65 20 80 20 28 32  35 35 2d 62 69 74 76 61  |lue . (255-bitva|
00000490  6c 75 65 29 0d 33 18 18  20 f2 70 6f 6b 65 28 26  |lue).3.. .poke(&|
000004a0  36 30 2c 6e 65 77 76 61  6c 75 65 29 0d 33 22 06  |60,newvalue).3".|
000004b0  20 e1 0d 36 b0 66 20 f4  20 2a 2a 2a 54 45 53 54  | ..6.f . ***TEST|
000004c0  53 20 54 48 45 20 43 55  52 52 45 4e 54 20 53 54  |S THE CURRENT ST|
000004d0  41 54 45 20 4f 46 20 54  48 45 20 53 50 45 43 49  |ATE OF THE SPECI|
000004e0  46 49 45 44 20 49 4e 50  55 54 20 28 34 2d 37 29  |FIED INPUT (4-7)|
000004f0  20 41 4e 44 20 52 45 54  55 52 4e 53 20 54 48 45  | AND RETURNS THE|
00000500  20 56 41 4c 55 45 20 22  4f 4e 22 20 4f 52 20 22  | VALUE "ON" OR "|
00000510  4f 46 46 22 2e 2a 2a 2a  0d 36 ba 19 20 dd 20 a4  |OFF".***.6.. . .|
00000520  74 65 73 74 28 6c 69 6e  65 6e 75 6d 62 65 72 29  |test(linenumber)|
00000530  20 0d 36 c4 2f 20 e7 20  28 6c 69 6e 65 6e 75 6d  | .6./ . (linenum|
00000540  62 65 72 3e 37 20 84 20  6c 69 6e 65 6e 75 6d 62  |ber>7 . linenumb|
00000550  65 72 3c 34 29 20 8c 20  2a 46 58 31 32 35 20 20  |er<4) . *FX125  |
00000560  0d 36 ce 0f 20 ea 20 62  69 74 76 61 6c 75 65 0d  |.6.. . bitvalue.|
00000570  36 d8 1a 20 62 69 74 76  61 6c 75 65 3d 32 5e 6c  |6.. bitvalue=2^l|
00000580  69 6e 65 6e 75 6d 62 65  72 0d 36 e2 2e 20 72 65  |inenumber.6.. re|
00000590  73 75 6c 74 3d 28 28 a4  70 65 65 6b 28 26 36 30  |sult=((.peek(&60|
000005a0  29 20 80 20 62 69 74 76  61 6c 75 65 29 3d 62 69  |) . bitvalue)=bi|
000005b0  74 76 61 6c 75 65 29 0d  36 ec 1e 20 e7 20 72 65  |tvalue).6.. . re|
000005c0  73 75 6c 74 20 8c 20 3d  22 4f 4e 22 20 8b 20 3d  |sult . ="ON" . =|
000005d0  22 4f 46 46 22 0d 3a 98  99 20 f4 20 2a 2a 2a 54  |"OFF".:.. . ***T|
000005e0  45 53 54 53 20 54 48 45  20 53 54 41 54 45 20 4f  |ESTS THE STATE O|
000005f0  46 20 54 48 45 20 53 50  45 43 49 46 49 45 44 20  |F THE SPECIFIED |
00000600  52 45 4c 41 59 53 20 49  4e 20 54 55 52 4e 20 41  |RELAYS IN TURN A|
00000610  4e 44 20 53 57 41 50 53  20 54 48 45 4d 2e 20 52  |ND SWAPS THEM. R|
00000620  45 51 55 49 52 45 53 20  41 20 53 54 52 49 4e 47  |EQUIRES A STRING|
00000630  20 52 45 50 52 45 53 45  4e 54 49 4e 47 20 54 48  | REPRESENTING TH|
00000640  45 20 52 45 4c 41 59 53  20 54 4f 20 42 45 20 54  |E RELAYS TO BE T|
00000650  4f 47 47 4c 45 44 20 41  53 20 41 20 42 49 4e 41  |OGGLED AS A BINA|
00000660  52 59 20 50 41 54 54 45  52 4e 2e 2a 2a 2a 0d 3a  |RY PATTERN.***.:|
00000670  a2 1e 20 dd 20 f2 6d 75  6c 74 69 74 6f 67 67 6c  |.. . .multitoggl|
00000680  65 28 70 61 74 74 65 72  6e 24 29 20 0d 3a ac 23  |e(pattern$) .:.#|
00000690  20 ea 20 4c 2c 4c 24 2c  6d 61 73 6b 25 2c 6f 6c  | . L,L$,mask%,ol|
000006a0  64 76 61 6c 75 65 2c 6e  65 77 76 61 6c 75 65 0d  |dvalue,newvalue.|
000006b0  3a b6 1e 20 e7 20 a9 28  70 61 74 74 65 72 6e 24  |:.. . .(pattern$|
000006c0  29 3c 3e 34 20 8c 20 2a  46 58 31 32 35 0d 3a c0  |)<>4 . *FX125.:.|
000006d0  3e 20 e3 20 4c 3d 31 20  b8 20 34 3a 4c 24 3d c1  |> . L=1 . 4:L$=.|
000006e0  70 61 74 74 65 72 6e 24  2c 4c 2c 31 29 3a e7 20  |pattern$,L,1):. |
000006f0  ac 28 4c 24 3d 22 31 22  20 84 20 4c 24 3d 22 30  |.(L$="1" . L$="0|
00000700  22 29 20 8c 20 2a 46 58  31 32 35 0d 3a ca 06 20  |") . *FX125.:.. |
00000710  ed 0d 3a d4 45 20 6d 61  73 6b 25 3d 30 3a e3 20  |..:.E mask%=0:. |
00000720  4c 3d 31 20 b8 20 34 3a  e7 20 28 c1 70 61 74 74  |L=1 . 4:. (.patt|
00000730  65 72 6e 24 2c 4c 2c 31  29 3d 22 31 22 29 20 8c  |ern$,L,1)="1") .|
00000740  20 6d 61 73 6b 25 3d 6d  61 73 6b 25 2b 32 5e 28  | mask%=mask%+2^(|
00000750  34 2d 4c 29 20 20 0d 3a  de 06 20 ed 0d 3a e8 32  |4-L)  .:.. ..:.2|
00000760  20 6f 6c 64 76 61 6c 75  65 3d a4 70 65 65 6b 28  | oldvalue=.peek(|
00000770  26 36 30 29 3a 6e 65 77  76 61 6c 75 65 3d 6f 6c  |&60):newvalue=ol|
00000780  64 76 61 6c 75 65 20 82  20 6d 61 73 6b 25 0d 3a  |dvalue . mask%.:|
00000790  f2 18 20 f2 70 6f 6b 65  28 26 36 30 2c 6e 65 77  |.. .poke(&60,new|
000007a0  76 61 6c 75 65 29 0d 3a  fc 06 20 e1 0d 3e 80 ca  |value).:.. ..>..|
000007b0  20 f4 20 2a 2a 2a 54 55  52 4e 53 20 4f 4e 20 4f  | . ***TURNS ON O|
000007c0  52 20 4f 46 46 20 54 48  45 20 53 50 45 43 49 46  |R OFF THE SPECIF|
000007d0  49 45 44 20 47 52 4f 55  50 20 4f 46 20 52 45 4c  |IED GROUP OF REL|
000007e0  41 59 53 2e 20 20 52 45  51 55 49 52 45 53 20 54  |AYS.  REQUIRES T|
000007f0  57 4f 20 50 41 52 41 4d  45 54 45 52 53 3a 2d 28  |WO PARAMETERS:-(|
00000800  69 29 54 48 45 20 41 43  54 49 4f 4e 20 54 4f 20  |i)THE ACTION TO |
00000810  42 45 20 54 41 4b 45 4e  20 69 65 2e 22 4f 4e 22  |BE TAKEN ie."ON"|
00000820  20 4f 52 20 22 4f 46 46  22 2c 20 28 69 69 29 41  | OR "OFF", (ii)A|
00000830  20 53 54 52 49 4e 47 20  52 45 50 52 45 53 45 4e  | STRING REPRESEN|
00000840  54 49 4e 47 20 54 48 45  20 52 45 4c 41 59 53 20  |TING THE RELAYS |
00000850  54 4f 20 42 45 20 53 57  49 54 43 48 45 44 20 41  |TO BE SWITCHED A|
00000860  53 20 41 20 42 49 4e 41  52 59 20 50 41 54 54 45  |S A BINARY PATTE|
00000870  52 4e 2e 2a 2a 2a 0d 3e  8a 24 20 dd 20 f2 6d 75  |RN.***.>.$ . .mu|
00000880  6c 74 69 74 75 72 6e 28  6f 6e 4f 52 6f 66 66 24  |ltiturn(onORoff$|
00000890  2c 70 61 74 74 65 72 6e  24 29 0d 3e 94 23 20 ea  |,pattern$).>.# .|
000008a0  20 4c 2c 4c 24 2c 6d 61  73 6b 25 2c 6f 6c 64 76  | L,L$,mask%,oldv|
000008b0  61 6c 75 65 2c 6e 65 77  76 61 6c 75 65 0d 3e 9e  |alue,newvalue.>.|
000008c0  42 20 e7 20 a9 28 70 61  74 74 65 72 6e 24 29 3c  |B . .(pattern$)<|
000008d0  3e 34 20 84 20 ac 28 6f  6e 4f 52 6f 66 66 24 3d  |>4 . .(onORoff$=|
000008e0  22 4f 4e 22 20 84 20 6f  6e 4f 52 6f 66 66 24 3d  |"ON" . onORoff$=|
000008f0  22 4f 46 46 22 29 20 8c  20 2a 46 58 31 32 35 0d  |"OFF") . *FX125.|
00000900  3e a8 3e 20 e3 20 4c 3d  31 20 b8 20 34 3a 4c 24  |>.> . L=1 . 4:L$|
00000910  3d c1 70 61 74 74 65 72  6e 24 2c 4c 2c 31 29 3a  |=.pattern$,L,1):|
00000920  e7 20 ac 28 4c 24 3d 22  31 22 20 84 20 4c 24 3d  |. .(L$="1" . L$=|
00000930  22 30 22 29 20 8c 20 2a  46 58 31 32 35 0d 3e b2  |"0") . *FX125.>.|
00000940  06 20 ed 0d 3e bc 45 20  6d 61 73 6b 25 3d 30 3a  |. ..>.E mask%=0:|
00000950  e3 20 4c 3d 31 20 b8 20  34 3a e7 20 28 c1 70 61  |. L=1 . 4:. (.pa|
00000960  74 74 65 72 6e 24 2c 4c  2c 31 29 3d 22 31 22 29  |ttern$,L,1)="1")|
00000970  20 8c 20 6d 61 73 6b 25  3d 6d 61 73 6b 25 2b 32  | . mask%=mask%+2|
00000980  5e 28 34 2d 4c 29 20 20  0d 3e c6 06 20 ed 0d 3e  |^(4-L)  .>.. ..>|
00000990  d0 66 20 6f 6c 64 76 61  6c 75 65 3d a4 70 65 65  |.f oldvalue=.pee|
000009a0  6b 28 26 36 30 29 3a e7  20 6f 6e 4f 52 6f 66 66  |k(&60):. onORoff|
000009b0  24 3d 22 4f 4e 22 20 8c  20 6e 65 77 76 61 6c 75  |$="ON" . newvalu|
000009c0  65 3d 6f 6c 64 76 61 6c  75 65 20 84 20 6d 61 73  |e=oldvalue . mas|
000009d0  6b 25 20 8b 20 6e 65 77  76 61 6c 75 65 3d 6f 6c  |k% . newvalue=ol|
000009e0  64 76 61 6c 75 65 20 80  20 28 32 35 35 2d 6d 61  |dvalue . (255-ma|
000009f0  73 6b 25 29 0d 3e da 18  20 f2 70 6f 6b 65 28 26  |sk%).>.. .poke(&|
00000a00  36 30 2c 6e 65 77 76 61  6c 75 65 29 0d 3e e4 06  |60,newvalue).>..|
00000a10  20 e1 0d 42 68 d3 20 f4  20 2a 2a 2a 54 45 53 54  | ..Bh. . ***TEST|
00000a20  53 20 54 48 45 20 53 50  45 43 49 46 49 45 44 20  |S THE SPECIFIED |
00000a30  47 52 4f 55 50 20 4f 46  20 49 4e 50 55 54 53 20  |GROUP OF INPUTS |
00000a40  41 4e 44 20 52 45 54 55  52 4e 53 20 54 48 45 20  |AND RETURNS THE |
00000a50  56 41 4c 55 45 20 22 4f  4e 22 20 49 46 20 41 4c  |VALUE "ON" IF AL|
00000a60  4c 20 4f 46 20 54 48 45  4d 20 41 52 45 20 4f 4e  |L OF THEM ARE ON|
00000a70  20 41 4e 44 20 22 4f 46  46 22 20 49 46 20 41 4e  | AND "OFF" IF AN|
00000a80  59 20 4f 4e 45 20 4f 46  20 54 48 45 4d 20 49 53  |Y ONE OF THEM IS|
00000a90  20 4f 46 46 2e 20 20 52  45 51 55 49 52 45 53 20  | OFF.  REQUIRES |
00000aa0  41 20 53 54 52 49 4e 47  20 52 45 50 52 45 53 45  |A STRING REPRESE|
00000ab0  4e 54 49 4e 47 20 54 48  45 20 49 4e 50 55 54 53  |NTING THE INPUTS|
00000ac0  20 54 4f 20 42 45 20 54  45 53 54 45 44 20 41 53  | TO BE TESTED AS|
00000ad0  20 41 20 42 49 4e 41 52  59 20 50 41 54 54 45 52  | A BINARY PATTER|
00000ae0  4e 2e 2a 2a 2a 0d 42 72  1c 20 dd 20 a4 6d 75 6c  |N.***.Br. . .mul|
00000af0  74 69 74 65 73 74 28 70  61 74 74 65 72 6e 24 29  |titest(pattern$)|
00000b00  20 0d 42 7c 1c 20 ea 20  4c 2c 4c 24 2c 74 65 73  | .B|. . L,L$,tes|
00000b10  74 6d 61 73 6b 25 2c 72  65 73 75 6c 74 0d 42 86  |tmask%,result.B.|
00000b20  1e 20 e7 20 a9 28 70 61  74 74 65 72 6e 24 29 3c  |. . .(pattern$)<|
00000b30  3e 34 20 8c 20 2a 46 58  31 32 35 0d 42 90 3e 20  |>4 . *FX125.B.> |
00000b40  e3 20 4c 3d 31 20 b8 20  34 3a 4c 24 3d c1 70 61  |. L=1 . 4:L$=.pa|
00000b50  74 74 65 72 6e 24 2c 4c  2c 31 29 3a e7 20 ac 28  |ttern$,L,1):. .(|
00000b60  4c 24 3d 22 31 22 20 84  20 4c 24 3d 22 30 22 29  |L$="1" . L$="0")|
00000b70  20 8c 20 2a 46 58 31 32  35 0d 42 9a 06 20 ed 0d  | . *FX125.B.. ..|
00000b80  42 a4 50 20 74 65 73 74  6d 61 73 6b 25 3d 30 3a  |B.P testmask%=0:|
00000b90  e3 20 4c 3d 31 20 b8 20  34 3a e7 20 28 c1 70 61  |. L=1 . 4:. (.pa|
00000ba0  74 74 65 72 6e 24 2c 4c  2c 31 29 3d 22 31 22 29  |ttern$,L,1)="1")|
00000bb0  20 8c 20 74 65 73 74 6d  61 73 6b 25 3d 74 65 73  | . testmask%=tes|
00000bc0  74 6d 61 73 6b 25 2b 32  5e 28 38 2d 4c 29 20 0d  |tmask%+2^(8-L) .|
00000bd0  42 ae 06 20 ed 0d 42 b8  31 20 72 65 73 75 6c 74  |B.. ..B.1 result|
00000be0  3d 28 28 a4 70 65 65 6b  28 26 36 30 29 20 80 20  |=((.peek(&60) . |
00000bf0  74 65 73 74 6d 61 73 6b  25 29 3d 74 65 73 74 6d  |testmask%)=testm|
00000c00  61 73 6b 25 29 20 0d 42  c2 1e 20 e7 20 72 65 73  |ask%) .B.. . res|
00000c10  75 6c 74 20 8c 20 3d 22  4f 4e 22 20 8b 20 3d 22  |ult . ="ON" . ="|
00000c20  4f 46 46 22 0d 46 50 6c  20 f4 20 2a 2a 2a 49 4e  |OFF".FPl . ***IN|
00000c30  49 54 49 41 4c 49 53 45  53 20 55 53 45 52 20 50  |ITIALISES USER P|
00000c40  4f 52 54 20 41 53 20 46  4f 55 52 20 4f 55 54 50  |ORT AS FOUR OUTP|
00000c50  55 54 53 20 4f 4e 20 50  42 30 2d 33 20 41 4e 44  |UTS ON PB0-3 AND|
00000c60  20 46 4f 55 52 20 49 4e  50 55 54 53 20 4f 4e 20  | FOUR INPUTS ON |
00000c70  50 42 34 2d 37 2e 20 54  55 52 4e 53 20 41 4c 4c  |PB4-7. TURNS ALL|
00000c80  20 4f 55 54 50 55 54 53  20 4f 46 46 2e 2a 2a 2a  | OUTPUTS OFF.***|
00000c90  0d 46 5a 13 20 dd 20 f2  73 65 74 5f 75 70 5f 70  |.FZ. . .set_up_p|
00000ca0  6f 72 74 0d 46 64 12 20  f2 70 6f 6b 65 28 26 36  |ort.Fd. .poke(&6|
00000cb0  32 2c 31 35 29 0d 46 6e  11 20 f2 70 6f 6b 65 28  |2,15).Fn. .poke(|
00000cc0  26 36 30 2c 30 29 0d 46  78 06 20 e1 0d ff        |&60,0).Fx. ...|
00000cce
A.INTPROC.m0
A.INTPROC.m1
A.INTPROC.m2
A.INTPROC.m4
A.INTPROC.m5

© Dominic Ford 2021–2024.

Our privacy policy is here.
Last updated: 28 Jul 2024, 23:31 UTC
Website designed by .