10REM  SIMUL8 - MODE-7 page printer   
   20REM  This program must first be
   30REM  SAVE'd, and PAGE reset to
   40REM  PAGE+&600
   50REM  before re-loading and running.
   60REM  The MODE-7 page to printed
   70REM  should have been *SAVE'd,
   80REM  and this program will prompt
   90REM  for it's file name.
  100 
  120 
  130*FX20,6
  140MODE9
  150ON ERROR GOTO 1410
  160 
  170Page_Width = 40: Page_Height = 24
  180 
  190DIM teletext &500: REM Page_Width*Page_Height-1 (plus a bit extra!)
  200 
  210GERMAN = 4
  220SWEDISH = 2
  230alphanumerics = 0
  240contiguous = 128-32
  250separated = 128
  260 
  270graph_mode = 1
  280hold_graphics = 2
  290double_height = 4
  300flash_mode = 8
  310 
  320DIM c% 7   :REM these are local to later procedures
  330DIM defn 8
  350 
  360PRINT TAB(1,27)"Defining graphics characters...";
  370PROCdefchars
  380 
  390MOVE0,240:PLOT21,1280,240
  400 
  410REPEAT
  420COLOUR 7: COLOUR 128
  430VDU 28,0,31,39,25,12
  440 
  450  REPEAT
  460    INPUT LINE TAB(0,2)"Enter file name: " F$
  470  UNTIL F$<>""
  480 
  490PROCoscli("LOAD "+F$+" "+STR$~(teletext))
  500 
  510PROCLangChars (FNlanguage)
  520$teletext="Acorn  "
  530teletext?7=32   :REM Suppress binary header
  540COLOUR 7:COLOUR 128
  550VDU26,12:MOVE0,240:PLOT21,1280,240
  560PRINT TAB(0,27)"Plotting "F$"...";
  570 
  580 FOR y = 0 TO Page_Height-1
  590 
  600   REM Set 'start of row' defaults
  610 
  620   graph_font = contiguous
  630   font = alphanumerics
  640   mode = 0
  650   hold_char = 32
  660   double_flag = FALSE
  663   alpha_colour=7: graph_colour=7: colour=alpha_colour
  664   back_colour=0
  665   COLOUR colour: COLOUR 128+back_colour
  670 
  672   any_double = FNFind_double
  673 
  680   FOR x = 0 TO Page_Width-1
  690 
  700     char = teletext?(x+y*Page_Width) AND 127
  710     char = char - ((char AND 32) > 0 ) * font
  720   REM Amend 'char' to internal graphics character if appropriate.
  730 
  740   REM Do <Before> tests
  750 
  760     IF char>31 THEN 930
  770 
  780     IF char <> 12 GOTO 820
  790        mode = mode AND (NOT double_height)
  800        hold_char = 32
  810        GOTO 930
  820     IF char <> 13 GOTO 870
  830        mode=mode OR double_height
  840        double_flag = TRUE
  850        hold_char = 0
  860        GOTO 930
  870     IF char <> 30 GOTO 900
  880        mode = mode OR hold_graphics
  890        GOTO 930
  900     IF char <> 9 GOTO 912
  910        mode = mode AND (NOT flash_mode)
  911        GOTO 930
  912     IF char <> 28 GOTO 915
  913         back_colour = 0: COLOUR 128+back_colour
  914        GOTO 930
  915     IF char <> 29 GOTO 930
  916         back_colour=colour: COLOUR 128+back_colour
  917        GOTO 930
  920 
  930     char_store=char
  940     IF (mode AND hold_graphics) <> 0 AND (mode AND graph_mode) <> 0 AND (char<32) AND (hold_char<>0) THEN char=hold_char
  950 
  960   REM Draw
  970   IF (mode AND flash_mode)=0 THEN PROCdraw_char(x,y) ELSE PROCdraw_reverse(x,y)
  980     char=char_store
  990     IF char>127 THEN hold_char = char
 1000 
 1010   REM Do <After> tests
 1020 
 1030     IF char>31 THEN 1320
 1040     IF char <> 25 GOTO 1080
 1050         graph_font = contiguous
 1060        IF (mode AND graph_mode)<>0 THEN font = graph_font
 1070        GOTO 1320
 1080     IF char <> 26 GOTO 1120
 1090        graph_font = separated
 1100        IF (mode AND graph_mode)<>0 THEN font = graph_font
 1110        GOTO 1320
 1120     IF char <> 31 GOTO 1150
 1130        mode = mode AND (NOT hold_graphics)
 1140        GOTO 1320
 1150      IF char <> 8 GOTO 1180
 1160        mode = mode OR flash_mode
 1161        GOTO 1320
 1180     IF NOT( (1 <= (char AND 15)) AND ((char AND 15) <= 7) ) GOTO 1320
 1190   REM Bypass unless Alpha or Graphics colour change.
 1200 
 1210        IF (char AND 16) = 0 GOTO 1290
 1220 
 1230   REM Graphics colour change
 1240           mode = mode OR graph_mode
 1250           font = graph_font
 1251COLOUR char AND 7
 1252graph_colour=char AND 7: colour=graph_colour
 1260           GOTO 1320
 1270 
 1280   REM Alpha colour change
 1290           mode = mode AND (NOT graph_mode)
 1300           font = alphanumerics
 1310           hold_char = 0
 1311COLOUR char AND 7
 1312alpha_colour=char AND 7: colour=alpha_colour
 1320   NEXT
 1330 IF double_flag THEN y=y+1
 1340 NEXT
 1350 
 1360PRINT TAB(0,27)"Printing "F$"...";
 1370PROCprinter
 1380 
 1390UNTIL FALSE
 1400 
 1410VDU 28,0,31,39,25,10,10
 1420REPORT:PRINT" at line ";ERL
 1421*FX 20 0
 1422*FX 20 6
 1423COLOUR 7: COLOUR 128
 1430END
 1431 
 1432DEFFNFind_double
 1433LOCAL X
 1434FOR X=0 TO 39
 1435   IF ((teletext?(X+y*Page_Width)) AND 127) = 13 THEN =TRUE
 1436NEXT
 1437=FALSE
 1438 
 1440 
 1450DEFPROCdraw_char(x,y)
 1451VDU 23,32,0,0,0,0,0,0,0,0
 1460   PRINT TAB(x,y);
 1461   IF any_double THEN VDU 10,32,8,11
 1470   IF (char<33) AND ((mode AND double_height)=0) THEN VDU 32: ENDPROC
 1471   IF ((char=128) OR (char=128+32)) AND ((mode AND double_height)=0) THEN VDU 32: ENDPROC
 1480   IF (mode AND double_height) = 0  AND (mode AND graph_mode)=0 AND (char=127) THEN PROCblodge:ENDPROC
 1490   IF (mode AND double_height) = 0 THEN VDU char: ENDPROC
 1500 
 1510     REM Explode char into CHR$128 (top half) and CHR$128+32 (lower)
 1511   IF (char<33) OR (char=128) OR (char=128+32) THEN VDU 32,8,10,32,11: ENDPROC
 1520   PROCdouble
 1530   VDU 128,8,10,128+32,11
 1540ENDPROC
 1550 
 1560DEFPROCdraw_reverse(x,y)
 1570   COLOUR colour+8
 1580   PROCdraw_char(x,y)
 1590   COLOUR colour
 1600ENDPROC
 1610 
 1620DEFPROCdefchars
 1630 
 1640left% = &F0: right% = &0F
 1650 
 1660FOR ch = 128+32 TO 128+63
 1670   PROCdef(ch, ch-128)    :REM 32..63
 1680   PROCdef(ch+64, ch-64)  :REM 96..127
 1690NEXT
 1700 
 1710PROCnon_standard
 1720ENDPROC
 1730 
 1740DEFPROCdef(code%, char%)
 1750c%!0=0:c%!4=0  : REM Clear character
 1760 
 1770IF (char% AND 1) <> 0 THEN c%?0 = left% : c%?1 = left% : c%?2 = left%
 1780IF (char% AND 2) <> 0 THEN c%?0 = c%?0 OR right% : c%?1 = c%?1 OR right% : c%?2 = c%?2 OR right%
 1790IF (char% AND 4) <> 0 THEN c%?3 = left% : c%?4 = left%
 1800IF (char% AND 8) <> 0 THEN c%?3 = c%?3 OR right% : c%?4 = c%?4 OR right%
 1810IF (char% AND &30) = &30 THEN c%?5 = left% : c%?6 = left% : c%?7 = left%
 1820IF (char% AND &60) = &60 THEN c%?5 = c%?5 OR right% : c%?6 = c%?6 OR right% : c%?7 = c%?7 OR right%
 1830 
 1840VDU 23,code%-32,c%?0,c%?1,c%?2,c%?3,c%?4,c%?5,c%?6,c%?7
 1850VDU 23,code%,c%?0 AND &77,c%?1 AND &77,0,c%?3 AND &77,0,c%?5 AND &77,c%?6 AND &77,0
 1860 
 1870   REM  &77 is the vertical mask for separated graphics; bytes 2,4, and 7  being 0,  provide the horizontal mask.
 1880ENDPROC
 1890 
 1900DEFPROCnon_standard
 1910VDU 23,ASC("*"),0,&08,&2A,&1C,&1C,&2A,&08,0   :REM star      [42]
 1920ENDPROC
 1930 
 1940DEFPROCdouble
 1950PROCgetdef(char)
 1960VDU 23,128,defn?1,defn?1,defn?2,defn?2,defn?3,defn?3,defn?4,defn?4
 1970VDU 23,128+32,defn?5,defn?5,defn?6,defn?6,defn?7,defn?7,defn?8,defn?8
 1980ENDPROC
 1990 
 2000DEFPROCgetdef(ch)
 2010A%=10:X%=defn:Y%=defn DIV 256
 2020defn?0=ch
 2030CALL&FFF1
 2040ENDPROC
 2050 
 2060DEFPROCoscli(osi$)
 2061OSCLI(osi$):ENDPROC
 2070DIM txt 40
 2080$txt=osi$
 2090X%=txt MOD 256:Y%=txt DIV 256
 2100CALL &FFF7
 2110ENDPROC
 2120 
 2130DEFPROCblodge
 2140VDU 23,128,0,&7F,&7F,&7F,&7F,&7F,&7F,0
 2150VDU128
 2160ENDPROC
 2170 
 2180 
 2190DEFPROCprinter
 2200REM Graphics-Dump routine
 2210ENDPROC
 2220DEFFNlanguage
 2221=0
 2230=FNhamm(teletext?7) DIV 2
 2240ENDPROC
 2250DEFFNhamm(I)
 2260DIM PB 15
 2270PB?0 = &8E
 2280PB?1 = I
 2290A%=&7A:X%=PB:Y%=PB DIV 256
 2300PYXA%=USR(&FFF1)
 2310=PB?1
 2320DEFPROCLangChars(Lang)
 2321*FX20,0
 2322*FX20,6
 2330IF Lang=GERMAN THEN PROCDeutsch:ENDPROC
 2340IF Lang=SWEDISH THEN PROCSvensk:ENDPROC
 2350PROCEnglish
 2360ENDPROC
 2370DEFPROCDeutsch
 2380VDU 23,35,&36,&36,&7F,&36,&7F,&36,&36,&0
 2390VDU 23,36,&C,&3F,&68,&3E,&B,&7E,&18,&0
 2400VDU 23,39,&C,&18,&30,&0,&0,&0,&0,&0
 2410VDU 23,44,&0,&0,&0,&0,&0,&18,&18,&30
 2420VDU 23,46,&0,&0,&0,&0,&0,&18,&18,&0
 2430VDU 23,64,14,17,16,14,14,1,17,14
 2440VDU 23,91,&66,0,&3C,&66,&66,&7E,&66,&66
 2450VDU 23,92,&66,0,&3C,&66,&66,&66,&66,&3C
 2460VDU 23,93,&66,0,&66,&66,&66,&66,&66,&3C
 2470VDU 23,94,&18,&3C,&66,&42,&0,&0,&0,&0
 2480VDU 23,95,&0,&0,&0,&0,&0,&0,&0,&FF
 2490VDU 23,96,0,6,9,9,6,0,0,0
 2500VDU 23,123,&66,&0,&3C,&6,&3E,&66,&3E,&0
 2510VDU 23,124,&66,&0,&3C,&66,&66,&66,&3C,&0
 2520VDU 23,125,&66,&0,&66,&66,&66,&66,&3E,&0
 2530VDU 23,126,&7C,&6C,&7C,&66,&66,&7C,&C0,&C0
 2540ENDPROC
 2550DEFPROCSvensk
 2560VDU 23,35,&36,&36,&7F,&36,&7F,&36,&36,&0
 2570VDU 23,36,&C,&3F,&68,&3E,&B,&7E,&18,&0
 2580VDU 23,39,0,0,0,0,0,0,0,0
 2590VDU 23,44,0,0,0,0,0,0,0,0
 2600VDU 23,46,0,0,0,0,0,0,0,0
 2610VDU 23,64,0,0,0,0,0,0,0,0
 2620VDU 23,91,0,0,0,0,0,0,0,0
 2630VDU 23,92,0,0,0,0,0,0,0,0
 2640VDU 23,93,&66,0,&66,&66,&66,&66,&66,&3C
 2650VDU 23,94,&18,&3C,&66,&42,&0,&0,&0,&0
 2660VDU 23,95,&0,&0,&0,&0,&0,&0,&0,&FF
 2670VDU 23,96,&1C,&36,&30,&7C,&30,&30,&7E,&0
 2680VDU 23,123,&66,&0,&3C,&6,&3E,&66,&3E,&0
 2690VDU 23,124,&66,&0,&3C,&66,&66,&66,&3C,&0
 2700VDU 23,125,&66,&0,&66,&66,&66,&66,&3E,&0
 2710VDU 23,126,&7C,&6C,&7C,&66,&66,&7C,&C0,&C0
 2720ENDPROC
 2730DEFPROCEnglish
 2740VDU 23,35,&1C,&36,&30,&7C,&30,&30,&7E,0
 2750VDU 23,36,0,0,0,0,0,0,0,0
 2760VDU 23,39,&18,&18,&18,0,0,0,0,0
 2770VDU 23,44,0,0,0,0,0,0,0,0
 2780VDU 23,46,0,0,0,0,0,0,0,0
 2790VDU 23,64,0,0,0,0,0,0,0,0
 2800VDU 23,91,0,&30,&60,&FE,&FE,&60,&30,0
 2810VDU 23,92,&60,&60,&60,&6E,&3,&6,&C,&F
 2820VDU 23,93,0,&0C,&06,&7F,&7F,&06,&0C,0
 2830VDU 23,94,&18,&3C,&7E,&5A,&18,&18,&18,0
 2840VDU 23,95,&36,&36,&7F,&36,&7F,&36,&36,0
 2850VDU 23,96,&0,&0,&0,&FF,&0,&0,&0,&0
 2860VDU 23,123,&60,&60,&60,&62,&6,&A,&F,&2
 2870VDU 23,124,&36,&36,&36,&36,&36,&36,&36,0
 2880VDU 23,125,&70,&18,&70,&19,&73,&5,&7,&1
 2890VDU 23,126,0,&18,0,&7E,0,&18,0,0
 2900ENDPROC
 2910DEFPROCx(C)
 2920PROCgetdef(C)
 2930PRINT"VDU 23,";C;
 2940FOR z=1 TO 8
 2950PRINT",&";~defn?z;
 2960NEXT
 2970PRINT
 2980ENDPROC