Option explicit
Option default integer
Dim p1,f1,e1,s1,o1,p2,f2,e2,s2,o2,p3,f3,e3,s3,o3
' set pins that will be used as outputs
SetPin gp4,pio1
SetPin gp16,pio1
SetPin gp17,pio1
'
o1=Pio(next line 1) 'note the start of the first PIO instruction for program 1 - will be 0
Print "compiling pclk"
PIO assemble 1
.program pclk
.side set 1
.line next 'we can always use next unless we specifically want to place the code
   Pull block 'read in the loop counter which will define the timing of the second program
.wrap target
   Mov x,osr side 1 [4] 'we can use osr to keep this and re-use it
.label loop 'loop as specified by the counter
   Nop side 0 [4]
   Jmp x--,loop side 1 [4]
   IRQ 0 side 0 [3] 'set a flag for the second program
   IRQ 4 side 0  'set a flag for the third program
.wrap
.end program list
' create the setting to initialise program 1
p1=Pio(pinctrl 1,,,,gp4)
f1=252000000
e1=Pio(execctrl GP0,Pio(.wrap target),Pio(.wrap))
s1=Pio(shiftctrl 0,0,0,0,0,0)
'
o2=Pio(next line) 'note the start of the second pio program
Print "compiling hsync @ line: ";o2
PIO assemble 1
 .program hsync
 .side set 1
 .line next 'this will pick up o2 automatically
   Pull block side 1 'get the length of the front port
   Mov y,osr side 1 'store the length of front porch in y
   Pull block side 1 'get the length of the sync pulse into osr
 .wrap target
   Mov x,osr side 1 'get the length of the synch
   Wait 1 irq 4 side 1 'this instruction waits for irq 4 to be set and automatically clears it
   ' this happens at the start of each line
.label loop1
   Jmp x--,loop1 side 0
   Mov x,y side 1 'restore the front porch value
.label loop2
   Jmp x--,loop2 side 1
   Nop side 1
'we will trigger the data transfer here
 .wrap
.end program list

' create the setting to initialise program 2
p2=Pio(pinctrl 1,,,,gp16)
f2=252000000
e2=Pio(execctrl GP0,Pio(.wrap target),Pio(.wrap))
s2=Pio(shiftctrl 0,0,0,0,0,0)

o3=Pio(next line) 'note the start of the second pio program
Print "compiling vsync @ line: ";o3
PIO assemble 1
 .program vsync
 .side set 1
 .line next 'this will pick up o3 automatically
   Pull block side 1
   Mov y,osr side 1 'store the length of the front porch in y
   Pull block side 1
   Mov isr,osr side 1 'store the length of the rest of the line in isr
   Pull block side 1 'get the synch length
 .wrap target
   Mov x,osr side 1 'get the synch length
   Wait 1 irq 0 side 1 'this instruction waits a line end which we use to be beginning of frame
.label loop3
   Jmp x--,loop3 side 0 'synch loop
   Mov x,y side 0
.label loop4
   Jmp x--,loop4 side 1 'front porch loop
   Mov x,isr side 1
.label loop5
   Jmp x--,loop5 side 1 'rest of line loop
 .wrap
.end program list

' create the setting to initialise program 3
p3=Pio(pinctrl 1,,,,gp17)
f3=252000000
e3=Pio(execctrl GP0,Pio(.wrap target),Pio(.wrap))
s3=Pio(shiftctrl 0,0,0,0,0,0)

' initialise and start program 1 but note it will block on pull block
PIO init machine 1,0,f1,p1,e1,s1,o1,1,0,0
PIO start 1,0
' initialise and start program 2, it will block waiting for the irq
PIO init machine 1,1,f2,p2,e2,s2,o2,1,0,0
PIO start 1,1
PIO write 1,1,2,48*10-2,96*10-2
' initialise and start program 3, it will block waiting for the irq
PIO init machine 1,2,f3,p3,e3,s3,o3,1,0,0
PIO start 1,2
'rest of line value is reduced to make sure no overun but also don't miss a line
PIO write 1,2,3,8000*33-1,8000*490-1000,8000*2-1
' trigger the whole shebang by writing to program 1 fifo
PIO write 1,0,1,800
' loop, although the PIO will keep running anyway even if the program finishes
Do
Loop

Option explicit
Option default integer
Dim o
' set pins that will be used as outputs
SetPin gp4,pio1
SetPin gp16,pio1
SetPin gp17,pio1
Const cyclesperpixel=10
Const hwholeline=800
Const hvisible=640*cyclesperpixel
Const hsync=96*cyclesperpixel
Const hfrontporch=16*cyclesperpixel
Const hbackporch=48*cyclesperpixel
Const vwholeframe=525*hwholeline*cyclesperpixel
Const vvisible=480*hwholeline*cyclesperpixel
Const vsync=2*hwholeline*cyclesperpixel
Const vfrontporch=10*hwholeline*cyclesperpixel
Const vbackporch=33*hwholeline*cyclesperpixel
Const clock=Val(MM.Info(cpuspeed))

'
o=Pio(next line 1) 'note the start of the first PIO instruction for program 1 - will be 0
Print "compiling pclk"
PIO assemble 1
.program pclk
.side set 1
.line next 'we can always use next unless we specifically want to place the code
   Pull block 'read in the loop counter which will define the timing of the second program
.wrap target
   Mov x,osr side 1 [4] 'we can use osr to keep this and re-use it
.label loop 'loop as specified by the counter
   Nop side 0 [4]
   Jmp x--,loop side 1 [4]
   IRQ 0 side 0  'set a flag for the second program
   IRQ 1 side 0 [3] 'set a flag for the third program
.wrap
.end program list
'PIO CONFIGURE pio, sm,clock [,startaddress][,sidesetbase] [,sidesetno][,sidesetout][,setbase] [,setno] [,setout]
'[,outbase] [,outno] [,outout][,inbase][,jmppin] [,wraptarget] [,wrap][,sideenable] [,sidepindir][,pushthreshold]
'[,pullthreshold] [,autopush][,autopull] [,inshiftdir][,outshiftdir][,joinrxfifo] [,jointxfifo][,joinrxfifoget] [,joinrxfifoput]
' create the setting to initialise program 1
PIO CONFIGURE 1,0,clock,o,gp4,1,1,,,,,,,,,Pio(.wrap target),Pio(.wrap)
' create the setting to initialise program 1
'PIO init machine 1,0,f1,p1,e1,s1,o1,1,0,0
'
o=Pio(next line) 'note the start of the second pio program
Print "compiling hsync @ line: ";o
PIO assemble 1
 .program hsync
 .side set 1
 .line next 'this will pick up o2 automatically
   Pull block side 1 'get the length of the sync
   Mov y,osr side 1 'save the length of the sync pulse into y
   Pull block side 1' get the length of the visible data + front porch in osr
 .wrap target
   Mov x,osr side 1 'get the length of the active+frontporch
   Wait 1 irq 1 side 1 'this instruction waits for irq 1 to be set by the pixel clock and automatically clears it
   IRQ NEXT 3 side 1
   ' this happens at the start of each line
.label loop1
   Jmp x--,loop1 side 1
   Mov x,y side 1 'restore the sync value
.label loop2
   Jmp x--,loop2 side 0
   Nop side 1
'we don't need to consider the back porch as we don't trigger again until the start of a new line
 .wrap
.end program list

' create the setting to initialise program 2
PIO CONFIGURE 1,1,clock,o,gp16,1,1,,,,,,,,,Pio(.wrap target),Pio(.wrap)

o=Pio(next line) 'note the start of the second pio program
Print "compiling vsync @ line: ";o
PIO assemble 1
 .program vsync
 .side set 1
 .line next 'this will pick up o3 automatically
   Pull block side 1
   Mov y,osr side 1 'store the length of the back porch in y
   Pull block side 1
   Mov isr,osr side 1 'store the length of sync in isr
   Pull block side 1 'get the synch length
 .wrap target
   Mov x,osr side 1 'get the length of the active + front porch
   Wait 1 irq 0 side 1 [1]'this instruction waits a line end which we use to be beginning of frame
   IRQ NEXT 4 side 1
.label loop3
   Jmp x--,loop3 side 1 'main data loop
   Mov x,isr side 1 'restore the sync value
.label loop4
   Jmp x--,loop4 side 0 'sync loop
   Mov x,y side 0
.label loop5
   Jmp x--,loop5 side 1 'rest of line loop
   IRQ CLEAR 0 side 1
 .wrap
.end program list

' create the setting to initialise program 3
PIO CONFIGURE 1,2,clock,o,gp17,1,1,,,,,,,,,Pio(.wrap target),Pio(.wrap)

' initialise and start program 1 but note it will block on pull block
PIO start 1,0
' initialise and start program 2, it will block waiting for the irq
PIO start 1,1
PIO write 1,1,2,hsync,hvisible+hfrontporch-2
' initialise and start program 3, it will block waiting for the irq
PIO start 1,2
'rest of line value is reduced to make sure no overun but also don't miss a line
PIO write 1,2,3,vbackporch-2,vsync,vvisible+vfrontporch-2
' trigger the whole shebang by writing to program 1 fifo
PIO write 1,0,1,hwholeline
' loop, although the PIO will keep running anyway even if the program finishes
Do
Loop

Option explicit
Option default integer
Dim o
' set pins that will be used as outputs
SetPin gp4,pio0
SetPin gp16,pio0
SetPin gp17,pio0

SetPin gp5,pio1
SetPin gp7,pio1
SetPin gp18,pio1
SetPin gp19,pio1
SetPin gp20,pio1
SetPin gp21,pio1
Const cyclesperpixel=10
Const hwholeline=800
Const hvisible=640
Const hvisiblepixel=hvisible*cyclesperpixel
Const hsync=96*cyclesperpixel
Const hfrontporch=16*cyclesperpixel
Const hbackporch=48*cyclesperpixel
Const vwholeframe=525*hwholeline*cyclesperpixel
Const vvisible=480
Const vvisiblepixel=vvisible*hwholeline*cyclesperpixel
Const vsync=2*hwholeline*cyclesperpixel
Const vfrontporch=10*hwholeline*cyclesperpixel
Const vbackporch=33*hwholeline*cyclesperpixel
Const clock=Val(MM.Info(cpuspeed))
Dim i,b(640*480\16)
Dim badd=Peek(varaddr b())
'
o=Pio(next line 1) 'note the start of the first PIO instruction for program 1 - will be 0
Print "compiling pclk"
PIO assemble 0
.program pclk
.side set 1
.line next 'we can always use next unless we specifically want to place the code
   Pull block 'read in the loop counter which will define the timing of the second program
.wrap target
   Mov x,osr side 1 [4] 'we can use osr to keep this and re-use it
.label loop 'loop as specified by the counter
   Nop side 0 [4]
   Jmp x--,loop side 1 [4]
   IRQ 0 side 0  'set a flag for the second program
   IRQ PREV 2 side 0
   IRQ 1 side 0 [2]  'set a flag for the third program
.wrap
.end program list
'PIO CONFIGURE pio, sm,clock [,startaddress][,sidesetbase] [,sidesetno][,sidesetout][,setbase] [,setno] [,setout]
'[,outbase] [,outno] [,outout][,inbase][,jmppin] [,wraptarget] [,wrap][,sideenable] [,sidepindir][,pushthreshold]
'[,pullthreshold] [,autopush][,autopull] [,inshiftdir][,outshiftdir][,joinrxfifo] [,jointxfifo][,joinrxfifoget] [,joinrxfifoput]
' create the setting to initialise program 1
PIO CONFIGURE 0,0,clock,o,gp4,1,1,,,,,,,,,Pio(.wrap target),Pio(.wrap)
' create the setting to initialise program 1
'PIO init machine 1,0,f1,p1,e1,s1,o1,1,0,0
'
o=Pio(next line) 'note the start of the second pio program
Print "compiling hsync @ line: ";o
PIO assemble 0
 .program hsync
 .side set 1
 .line next 'this will pick up o2 automatically
   Pull block side 1 'get the length of the sync
   Mov y,osr side 1 'save the length of the sync pulse into y
   Pull block side 1' get the length of the visible data + front porch in osr
 .wrap target
   Mov x,osr side 1 'get the length of the active+frontporch
   Wait 1 irq 1 side 1 'this instruction waits for irq 1 to be set by the pixel clock and automatically clears it
   ' this happens at the start of each line
.label loop1
   Jmp x--,loop1 side 1
   Mov x,y side 1 'restore the sync value
.label loop2
   Jmp x--,loop2 side 0
   Nop side 1
'we don't need to consider the back porch as we don't trigger again until the start of a new line
 .wrap
.end program list

' create the setting to initialise program 2
PIO CONFIGURE 0,1,clock,o,gp16,1,1,,,,,,,,,Pio(.wrap target),Pio(.wrap)

o=Pio(next line) 'note the start of the second pio program
Print "compiling vsync @ line: ";o
PIO assemble 0
 .program vsync
 .side set 1
 .line next 'this will pick up o3 automatically
   Pull block side 1
   Mov y,osr side 1 'store the length of the back porch in y
   Pull block side 1
   Mov isr,osr side 1 'store the length of sync in isr
   Pull block side 1 'get the synch length
 .wrap target
   Mov x,osr side 1 'get the length of the active + front porch
   Wait 1 irq 0 side 1 [1]'this instruction waits a line end which we use to be beginning of frame
   IRQ PREV 3 side 1
.label loop3
   Jmp x--,loop3 side 1 'main data loop
   Mov x,isr side 1 'restore the sync value
.label loop4
   Jmp x--,loop4 side 0 'sync loop
   Mov x,y side 0
.label loop5
   Jmp x--,loop5 side 1 'rest of line loop
   IRQ CLEAR 0 side 1
 .wrap
.end program list

' create the setting to initialise program 3
PIO CONFIGURE 0,2,clock,o,gp17,1,1,,,,,,,,,Pio(.wrap target),Pio(.wrap)
o=Pio(next line 0) 'note the start of the first PIO instruction for program 1 - will be 0

Print "compiling datamaster @ line: ";0
PIO assemble 1
 .program datamaster
 .line 0
 .side set 1
 Pull block side 0
 Mov y,osr side 0'store the count of active lines
.wrap target 'main loop
 Mov x,y side 0 'get the active line count
Wait 1 irq next 3 side 0 'wait for the start of frame
.label loop6
 Wait 1 irq next 2 side 1'wait for the next line to start
 IRQ  5 side 1 'trigger the output
 Jmp x--,loop6 side 1
.wrap
.end program list
PIO CONFIGURE 1,0,clock,o,gp5,1,1,,,,,,,,,Pio(.wrap target),Pio(.wrap)
o= Pio(next line)

Print "compiling data @ line: ";o
PIO assemble 1
 .program linedata
 .line next
 .side set 1
 Pull block side 0
 Mov y,osr side 0 'store active pixel count divided by the number of pixels per word
.wrap target
 Mov x,y side 0'get the active pixel count divided by the number of pixels per word
 Wait 1 irq 5 side 0 [9]'wait for next valid line to start
.label loop7
 Pull side 1 'get the next data - don't block
 Out pins,4 side 1 [9]
 Out pins,4 side 1 [9]
 Out pins,4 side 1 [9]
 Out pins,4 side 1 [9]
 Out pins,4 side 1 [9]
 Out pins,4 side 1 [9]
 Out pins,4 side 1 [9]
 Out pins,4 side 1 [9]
 Jmp x--,loop7 side 1
 Set pins, 0 side 0 [2]
.wrap
.end program list
' create the setting to initialise program 3
PIO CONFIGURE 1,1,clock,o,GP7,1,1,GP18,4,1,GP18,4,1,,,Pio(.wrap target),Pio(.wrap)
PIO SYNC 'this is a new command that syncs the clocks of the PIO. It is needed for IRQ to work between PIO

PIO start 1,0
PIO write 1,0,1,vvisible-1
PIO start 1,1
PIO write 1,1,1,hvisible/8-1
' initialise and start program 1 but note it will block on pull block
PIO start 0,0
' initialise and start program 2, it will block waiting for the irq
PIO start 0,1
PIO write 0,1,2,hsync-1,hvisiblepixel+hfrontporch-1
' initialise and start program 3, it will block waiting for the irq
PIO start 0,2
'rest of line value is reduced to make sure no overun but also don't miss a line
PIO write 0,2,3,vbackporch-1,vsync-1,vvisiblepixel+vfrontporch-1
' loop, although the PIO will keep running anyway even if the program finishes
PIO dma tx 1,1,640*480\8,b(),redo
' trigger the whole shebang by writing to program 1 fifo
PIO write 0,0,1,hwholeline
PIO sync
Do
mycls 1
Pause 1000
mycls 8
Pause 1000
rectangle 100,100,199,199,&H6
rectangle 0,0,639,0,&HF
rectangle 0,479,639,479,&HF
rectangle 0,0,0,479,&HF
rectangle 639,0,639,479,&HF
Pause 1000
Loop

Sub redo
PIO dma tx 1,1,640*480\8,b(),redo
End Sub

Sub mycls col
 Local c=col
 c=c+(c<<4)
 c=c+(c<<8)
 c=c+(c<<16)
 c=c+(c<<32)
 For i=0 To Bound(b(),1)-1
   b(i)=c
 Next
End Sub
Sub rectangle x1,y1,x2,y2,c
Local x,y,x1p,x2p,p,q,t,bc=(c<<4) +c
   For y=y1 To y2
       x1p = x1
       x2p = x2
       p = badd + y * (hvisible >> 1) + (x1 >> 1)
       If x1 Mod 2 Then
            t=(PEEK(BYTE p) And &HF) + (c<<4)
            Poke byte p,t
            Inc p
            Inc x1p
       EndIf

       If (x2 Mod 2) = 0 Then
           q = badd + y * (hvisible >> 1) + (x2 >> 1)
           t=(PEEK(BYTE q) And &Hf0) + c
           Poke byte q,t
           Inc x2p,-1
       EndIf
       For x = x1p To  x2p-1 Step 2
           Poke byte p,bc
           Inc p
       Next
     Next
End Sub