10 MODE 0
   20 ON ERROR VDU 7:RUN
   30 PROCassemble
   40 ON ERROR VDU 7:GOTO 60
   50 :
   60 REPEAT
   70 MODE 0
   80 RESTORE
   85 *DIR W
   90 *CAT
  100 INPUT'"Filename:"fname$
  110 PRINT'"Invert?";
  120 REPEAT
  130 pos=INSTR("NnYy",GET$)
  140 UNTIL pos>0
  150 VDU 23;8202;0;0;0;
  160 pos=(pos-1) DIV 2
  170 PRINT;MID$("NY",pos+1,1)
  180 ?eor=pos*255
  190 :
  200 ch%=OPENIN(fname$)
  210 X%=&70
  220 Y%=ch%
  230 A%=2
  240 CALL &FFDA
  250 L%=?&70+(?&71*256)
  260 L%=L%-8
  270 :
  280 FOR loop=0 TO 7
  290 bytes?loop=BGET# ch%
  300 NEXT
  310 Y%=bytes?4+1
  320 ?channel=ch%
  330 ?rows=Y%
  340 :
  350 A%=(&3000)+((Y%-1)DIV 8)*640+((Y%-1)MOD 8)
  360 ?addr=A% MOD 256
  370 addr?1=A% DIV 256
  380 P%=((L%/Y%)-INT(L%/Y%))*8
  390 ?extra=(P%-1) AND 7
  400 base=INT(L%/Y%)
  410 :
  420 FOR loop=0 TO ?extra
  430 FOR loop2=0 TO 7
  440 READ how
  450 howmany?loop2=base+how
  460 NEXT
  470 FOR loop2=0 TO 7
  480 READ shifttab?loop2
  490 NEXT
  500 NEXT
  510 IF INT(L%/Y%)=L%/Y% THEN ?endone=L%/Y% ELSE ?endone=INT(L%/Y%+1)
  520 ?endone=?endone-1
  530 :
  540 CLS
  550 CALL &900
  560 CLOSE #ch%
  570 *FX 15,0
  580 key=GET
  590 UNTIL 0
  600 END
  610 :
  620 DEFPROCassemble
  630 addr=&70
  640 number=&72
  650 shift=&73
  660 extra=&74
  670 sub=&75
  680 rowno=&76
  690 rows=&77
  700 endone=&78
  710 addr2=&79
  720 channel=&7B
  730 eor=&7C
  740 :
  750 osbget=&FFD7
  760 osargs=&FFDA
  770 :
  780 PRINT'"Assembling Code..."
  790 :
  800 FOR pass=0 TO 2 STEP 2
  810 P%=&900
  820 [OPT pass
  830 LDA #0
  840 STA rowno
  850 .mainloop
  860 LDX rowno
  870 LDA howmany,X
  880 STA number
  890 JSR rdbytes
  900 LDX rowno
  910 LDA shifttab,X
  920 STA shift
  930 JSR grshift
  940 LDX extra
  950 LDY endone
  960 LDA bytes,Y
  970 AND mask,X
  980 STA bytes,Y
  990 JSR display
 1000 LDA addr
 1010 AND #7
 1020 BEQ sub633
 1030 LDA addr
 1040 SEC
 1050 SBC #1
 1060 STA addr
 1070 BCS donesub
 1080 DEC addr+1
 1090 JMP donesub
 1100 .sub633
 1110 LDA addr
 1120 SEC
 1130 SBC #633 MOD 256
 1140 STA addr
 1150 LDA addr+1
 1160 SBC #633 DIV 256
 1170 STA addr+1
 1180 .donesub
 1190 LDX #&A8
 1200 LDY channel
 1210 LDA #0
 1220 JSR osargs
 1230 LDA &A8
 1240 SEC
 1250 SBC #1
 1260 STA &A8
 1270 LDA &A9
 1280 SBC #0
 1290 STA &A9
 1300 LDX #&A8
 1310 LDY channel
 1320 LDA #1
 1330 JSR osargs
 1340 LDA rowno
 1350 CLC
 1360 ADC #1
 1370 AND #7
 1380 STA rowno
 1390 DEC rows
 1400 BNE mainloop
 1410 RTS
 1420 .shifttab
 1430 EQUD (0)
 1440 EQUD (0)
 1450 .howmany
 1460 EQUD (0)
 1470 EQUD (0)
 1480 .mask
 1490 EQUB (128):EQUB (192)
 1500 EQUB (224):EQUB (240)
 1510 EQUB (248):EQUB (252)
 1520 EQUB (254):EQUB (255)
 1530 .bytes
 1540 EQUS (STRING$(82," "))
 1550 .rdbytes
 1560 LDY channel
 1570 LDX #0
 1580 .rdbloop
 1590 JSR osbget
 1600 EOR eor
 1610 STA bytes,X
 1620 INX
 1630 CPX number
 1640 BNE rdbloop
 1650 RTS
 1660 .grshift
 1670 LDA shift
 1680 BEQ shiftrts
 1690 LDX #81
 1700 CLC
 1710 .grsloop
 1720 ROL bytes,X
 1730 DEX
 1740 BPL grsloop
 1750 DEC shift
 1760 BNE grshift
 1770 .shiftrts
 1780 RTS
 1790 .display
 1800 LDA addr
 1810 STA addr2
 1820 LDA addr+1
 1830 STA addr2+1
 1840 LDX #255
 1850 .disploop
 1860 INX
 1870 LDA bytes,X
 1880 LDY #0
 1890 STA (addr2),Y
 1900 LDA addr2
 1910 CLC
 1920 ADC #8
 1930 STA addr2
 1940 BCC dispcc
 1950 INC addr2+1
 1960 .dispcc
 1970 CPX endone
 1980 BNE disploop
 1990 RTS
 2000 ]
 2010 NEXT
 2020 ENDPROC
 2030 :
 2040 DATA 1,1,1,1,1,1,1,2
 2050 DATA 0,1,2,3,4,5,6,7
 2060 :
 2070 DATA 1,1,1,2,1,1,1,2
 2080 DATA 0,2,4,6,0,2,4,6
 2090 :
 2100 DATA 1,1,2,1,1,2,1,2
 2110 DATA 0,3,6,1,4,7,2,5
 2120 :
 2130 DATA 1,2,1,2,1,2,1,2
 2140 DATA 0,4,0,4,0,4,0,4
 2150 :
 2160 DATA 1,2,1,2,2,1,2,2
 2170 DATA 0,5,2,7,4,1,6,3
 2180 :
 2190 DATA 1,2,2,2,1,2,2,2
 2200 DATA 0,6,4,2,0,6,4,2
 2210 :
 2220 DATA 1,2,2,2,2,2,2,2
 2230 DATA 0,7,6,5,4,3,2,1
 2240 :
 2250 DATA 1,1,1,1,1,1,1,1
 2260 DATA 0,0,0,0,0,0,0,0