
new

10 s=48928:cls:dim r(8):dim o(9)
30 b=1:a=15*16
40 c$="start hr":x=0:y=0:gosub 1000
50 c$="hr end": gosub 1200
60 for j=8 to 31
70 c$="r"+str$(j):y=j:x=0:gosub 1000
80 c$=str$(j)+"e":gosub 1200
90 next
100 gosub 1400: rem read vidregs
110 gosub 3000: rem y org, double height

999 end

1000 rem given a, b, x, y, c$, put c$ at x,y
1010 rem no limits checks
1020 POKES+2,B
1030 POKES+3,A
1040 POKES+6,Y
1050 x1=x
1060 for mc =1 to len(c$)
1070 c=asc(mid$(c$,mc,1))
1080 POKES+1,C
1090 POKES+7,X:x=x+1
1100 POKES+8,1
1110 next
1120 x=x1:return

1200 rem position string c$ on screen
1210 rem given a, b, y, c$, position so c$ ends on row y
1220 x=40 - len(c$)
1230 gosub 1000
1240 return

1400 rem read vidregs into array r
1410 poke s+8,128+8+1:r(1)=peek(s+1)
1420 poke s+8,128+8+2:r(2)=peek(s+1)
1430 poke s+8,128+8+3:r(3)=peek(s+1)
1440 poke s+8,128+8+4:r(4)=peek(s+1)
1450 poke s+8,128+8+7:r(7)=peek(s+1)
1455 for n=1 to 7:o(n)=r(n):next
1460 return

1500 rem store a character c,b,a at x,y
1510 POKES+1,C
1520 POKES+2,B
1530 POKES+3,A
1540 POKES+6,Y
1550 POKES+7,X
1560 POKES+8,1
1570 return


1600 rem store a character c at x,y using oct
1610 poke s+1,c:poke s+4,y:poke s+5,x:poke s+6,0
rem oct aux pointer
1620 poke s+8,3*16+5:return

1630 rem store a character b at x,y +1024 (b attrib) using oct
1640 poke s+1,b:poke s+4,y:poke s+5,x+128:poke s+6,0
rem oct aux ptr
1650 poke s+8,3*16+5:return

1660 rem store a character a at x,y +2048 (a attrib) using oct
1670 poke s+1,a:poke s+4,y:poke s+5,x+64:poke s+6,0
rem oct aux ptr
1680 poke s+8,3*16+5:return




1700 rem store array r back to vidregs
1710 poke s+1,r(1):poke s+8,128+1
1720 poke s+1,r(2):poke s+8,128+2
1730 poke s+1,r(3):poke s+8,128+3
1740 poke s+1,r(4):poke s+8,128+4
1750 poke s+1,r(7):poke s+8,128+7
1760 return

2000 rem inc border color
2010 n = 1 + (r(2) and 15): n=n and 15
2020 r(2) = (r(2) and (128+64+32+16)) or n
2030 gosub 1700
2040 return


2100 rem cursor on/off
2110 n= r(2):r(2)=r(2) and (255-64)
2120 if (n and 64) =0 then r(2)=r(2) or 64
2130 gosub 1700:return

2200 rem cursor mode increment
2210 n=r(2):n= (n+16) and (16+32)
2220 r(2)=(r(2) and (15+128+64)) or n
2230 gosub 1700:return

2250 rem service row toggle
2260 n=r(3):r(3)=r(3) and 254:if (n and 1)=0 then r(3) = r(3) or 1
2270 gosub 1700:return


2300 rem set video mode
2310 r(3)=r(3) and 127:r(1)=r(1) and 63
2320 n=val(a$)
2330 if (n and 1) then r(1)=r(1) or 64
2340 if (n and 2) then r(1)=r(1) or 128
2350 if (n and 4) then r(3)=r(3) or 128
2360 gosub 1700:return

2400 rem upper bulk toggle
2410 n=r(3):r(3)=r(3) and (255-2):if (n and 2)=0 then r(3) = r(3) or 2
2420 gosub 1700:return

2430 rem lower bulk toggle
2440 n=r(3):r(3)=r(3) and (255-4):if (n and 4)=0 then r(3) = r(3) or 4
2450 gosub 1700:return

2460 rem conceal toggle
2470 n=r(3):r(3)=r(3) and (255-8):if (n and 8)=0 then r(3) = r(3) or 8
2480 gosub 1700:return

2500 rem flash toggle
2510 n=r(3):r(3)=r(3) and (255-64):if (n and 64)=0 then r(3) = r(3) or 64
2520 gosub 1700:return

2530 rem toggle 525 line
2540 n=r(1):r(1)=r(1) and (255-1):if (n and 1)=0 then r(1) = r(1) or 1
2550 gosub 1700:return

2560 rem toggle interlace
2570 n=r(1):r(1)=r(1) and (255-2):if (n and 2)=0 then r(1) = r(1) or 2
2580 gosub 1700:return

2590 rem service row Y
2600 n=r(1):r(1)=r(1) and (255-32):if (n and 32)=0 then r(1) = r(1) or 32
2610 gosub 1700:return


2620 y1=(y1-1) and31:goto 2630
2625 y1=(y1+1) and31:goto 2630
2630 rem set row org to y1
2635 r(7)=(r(7) and (128+64+32)) or y1:gosub 1700
2640 c$=right$(str$(y1),2):x=15:y=22:gosub 1000:return

2690 rem toggle double high
2700 n=r(2):r(2)=r(2) and (255-128):if (n and 128)=0 then r(2)=r(2) or 128
2710 gosub 1700:return

2730 if cx<0 then cx=39
2732 if cx>39 then cx=0
2734 if cy<0 then cy=31
2736 if cy>31 then cy=0
2738 poke s+6,cy:poke s+7,cx:return:rem move cursor


3000 rem - fun stuff
3010 gosub 4000:rem plot sandbox
3020 gosub 4500:rem plot menu

3290 poke s+6,20:poke s+7,5:rem move cursor
3300 y1=8
3310 h=0
3330 a$=inkey$
3340 a$=inkey$:if a$="" then 3340
3350 if a$="," then gosub 2620:goto 3330
3360 if a$="." then gosub 2625:goto 3330
3450 if a$="h" then gosub2690:goto3330
3460 if a$="b" then gosub2000:goto3330
3470 if a$="c" then gosub2100:goto3330
3480 if a$="m" then gosub2200:goto3330
3490 if a$>="0" and a$<="7" then gosub 2300:goto 3330
3500 if a$="s" then gosub 2250:goto 3330
3505 if a$="u" then gosub 2400:goto 3330
3510 if a$="l" then gosub 2430:goto 3330
3515 if a$="d" then gosub 2460:goto 3330

3520 if a$="f" then gosub 2500:goto 3330
3525 if a$="n" then gosub 2530:goto 3330
3530 if a$="i" then gosub 2560:goto 3330
3535 if a$="r" then gosub 2460:goto 3330
3540 if asc(a$)=131 thencx=cx-1:gosub2730:goto 3330
3542 if asc(a$)=130 thencx=cx+1:gosub2730:goto 3330
3544 if asc(a$)=129 thency=cy-1:gosub2730:goto 3330
3546 if asc(a$)=128 thency=cy+1:gosub2730:goto 3330


3550 if a$<>"x" then 3340
3560 rem exit
3570 for n=1to7:r(n)=o(n):next:gosub1700
3590 return

4000 rem sandbox
4010 b=1:a=15*16

rem wide on odd x
4040 c$="wwiiddee":b=8:x=5:y=11:gosub 1000

rem wide on even x
4060 c$="ww":b=8:x=14:y=11:gosub 1000

rem wide with different c each time
4080 c$="wide":b=8:x=17:y=11:gosub 1000

rem wide with different colored characters
4100 c$="wwiiddee":b=8:x=22:y=11:gosub 1000
4110 c$="w":b=9:a=7:x=23:gosub 1000
4120 c$="i":b=9:a=3:x=25:gosub 1000

rem tall
4130 c$="tall":x=6:y=12:b=2:a=15*16:gosub 1000:x=6:y=13:gosub1000

rem tall and wide
4140 c$="ttww":x=11:y=12:b=10:gosub 1000:y=13:gosub1000

4190 c=128:b=128+7:a=4+6*16:x=5:y=8:gosub1500

4200 c=asc("i"):b=1:a=4+16*6:x=6:y=8:gosub1500
4210 c=asc("c"):b=4:a=4+16*6:x=7:y=8:gosub1500
4220 c=asc("f"):b=0:a=8+4+16*6:x=8:y=8:gosub1500
4230 c=asc("n"):b=0:a=128+4+16*6:x=9:y=8:gosub1500

rem 40 variable start line 9
4240 c=asc("R") or128:x=0:y=9:gosub1600

4250 for x=11 to 26:y=8:c=65:a=7*16:b=1+((x-11)*16):gosub1500:next

4490 return


4500 c$="X exit":b=1:a=15*16:x=5:y=17:gosub 1000
4510 c$="B border color":b=1:a=15*16:x=5:y=18:gosub 1000
4520 c$="C cursor":x=5:y=19:gosub 1000
4530 c$="M cursor mode":x=5:y=20:gosub 1000
4540 c$="0-7 video mode":x=5:y=21:gosub 1000
4550 c$=",. y-org":x=5:y=22:gosub 1000
4560 c$="H double high":x=5:y=23:gosub 1000
4570 c$="S service row":x=5:y=24:gosub 1000
4580 c$="U upper bulk":x=5:y=25:gosub 1000
4590 c$="L lower bulk":x=5:y=26:gosub 1000
4600 c$="D conceal enable":x=5:y=27:gosub 1000
4610 c$="F flash enable":x=5:y=28:gosub 1000
4620 c$="N 525 line":x=20:y=17:gosub 1000
4630 c$="I interlace":x=20:y=18:gosub 1000
4640 c$="R service row Y":x=20:y=19:gosub 1000
4650 c$="shift XCVB curs XY":x=20:y=20:gosub 1000

4700 return
