C64U UCI HTTP BASIC EXAMPLE

c64http.bas

10 rem c64u uci http query tester v1.6
20 print chr$(147):poke646,1:print "c64u uci http qry v1.6"
30 rem c() is command bytes, d() is uci reply bytes
40 dim c(260),d(260):dc=260
50 rem endpoint pieces: httpbin echoes query in json args
60 hn$="httpbin.org":qp$="codex=basic&uci=1"
70 pa$="/get?"+qp$:ag$="c64u-basic/1.0"
80 rem find uci, identify network target, open tcp
90 gosub 1000:if er then end
100 co=3:m$="uci base "+str$(ba):gosub 900
110 co=7:m$="identify network":gosub 900
120 c(0)=3:c(1)=1:cl=2:gosub 3000
130 if er then co=2:m$="identify failed "+s$:gosub 900:end
140 co=5:m$="network target ok":gosub 900
150 co=7:m$="open tcp "+hn$+":80":gosub 900
160 c(0)=3:c(1)=7:c(2)=80:c(3)=0:cl=4
170 q$=hn$+chr$(0):gosub 2000
180 gosub 3000
190 if er then co=2:m$="open failed "+s$:gosub 900:end
200 if dl<1 then co=2:m$="no socket id":gosub 900:end
210 so=d(0):co=5:m$="socket "+str$(so):gosub 900
220 rem build readable http request from strings
230 co=7:m$="build http request":gosub 900
240 rq$="GET "+pa$+" HTTP/1.1"+chr$(13)+chr$(10)
250 rq$=rq$+"Host: "+hn$+chr$(13)+chr$(10)
260 rq$=rq$+"User-Agent: "+ag$+chr$(13)+chr$(10)
270 rq$=rq$+"Accept: */*"+chr$(13)+chr$(10)
280 rq$=rq$+"Connection: close"+chr$(13)+chr$(10)+chr$(13)+chr$(10)
290 rem write_socket command: target 3, command 17, socket, payload
300 co=7:m$="send http request":gosub 900
310 c(0)=3:c(1)=17:c(2)=so:cl=3
320 q$=rq$:gosub 2000:wr=cl-3
330 gosub 3000
340 if er then co=2:m$="write failed "+s$:gosub 900:gosub 7000:end
350 if dl<2 then co=2:m$="write reply short":gosub 900:gosub 7000:end
360 ac=d(0)+256*d(1)
370 if ac<wr then co=2:m$="short write "+str$(ac):gosub 900:gosub 7000:end
380 co=5:m$="request sent":gosub 900
390 rem read response in chunks and print only body
400 co=7:m$="read response":gosub 900
410 poke646,1:print "---- json body ----"
420 hd=0:hm=0:bt=0:id=0:rc=0
430 c(0)=3:c(1)=16:c(2)=so:c(3)=128:c(4)=0:cl=5
440 gosub 3000
450 if er and left$(s$,2)="02" then id=id+1:goto 530
460 if er and left$(s$,2)="01" then goto 570
470 if er then co=2:m$="read failed "+s$:gosub 900:gosub 7000:end
480 if dl<2 then id=id+1:goto 530
490 ac=d(0)+256*d(1)
500 if ac=0 then id=id+1:goto 530
510 id=0:rc=rc+ac
520 for i=2 to ac+1:x=d(i):gosub 5000:next i
530 if id<60 and rc<4096 then goto 430
540 if rc=0 then co=2:m$="no response":gosub 900:gosub 7000:end
550 if id>=60 then co=2:m$="read timeout":gosub 900:gosub 7000:end
560 goto 580
570 co=5:m$="closed by host":gosub 900
580 gosub 7000
590 co=5:m$="done bytes "+str$(rc):gosub 900
600 poke646,1:end
890 rem sub 900: print m$ using color co for progress/fail status
900 poke646,co:print m$:return
990 rem sub 1000: locate ultimate command interface base register
1000 er=0:ba=57116
1010 if peek(ba+1)=201 then gosub 1100:return
1020 ba=56860
1030 if peek(ba+1)=201 then gosub 1100:return
1040 ba=57340
1050 if peek(ba+1)=201 then gosub 1100:return
1060 co=2:m$="uci not enabled":gosub 900
1070 er=1:return
1090 rem sub 1100: derive uci register addresses from base ba
1100 cs=ba:cd=ba+1:rd=ba+2:sd=ba+3:return
1990 rem sub 2000: append q$ to c() after petscii-to-ascii mapping
2000 for i=1 to len(q$)
2010 x=asc(mid$(q$,i,1)):gosub 2200
2020 c(cl)=x:cl=cl+1:next i:return
2190 rem sub 2200: map one basic string byte x to network wire ascii
2200 if x=13 or x=10 or x=9 or x=0 then return
2210 if x>=193 and x<=218 then x=x-128:return
2220 if x>=65 and x<=90 then x=x+32:return
2230 if x>=97 and x<=122 then return
2240 if x>=32 and x<=126 then return
2250 x=63:return
2990 rem sub 3000: send c() command, collect d() reply and s$ status
3000 er=0:dl=0:sl=0:s$=""
3010 gosub 3400:if er then return
3020 for i=0 to cl-1:poke cd,c(i):next i
3030 poke cs,1
3040 for w=1 to 20000
3050 zt=peek(cs)
3060 if (zt and 128)<>0 then x=peek(rd):if dl<dc then d(dl)=x:dl=dl+1
3070 if (zt and 128)<>0 then goto 3050
3080 if (zt and 64)<>0 then x=peek(sd):if sl<240 then s$=s$+chr$(x):sl=sl+1
3090 if (zt and 64)<>0 then goto 3050
3100 ss=zt and 48
3110 if (zt and 8)<>0 then poke cs,8:er=1:s$="uci error":return
3120 if (zt and 4)<>0 then poke cs,4:goto 3050
3130 if ss=32 or ss=48 then poke cs,2:goto 3050
3140 if ss=0 and (zt and 1)=0 then goto 3180
3150 next w
3160 er=1:s$="uci timeout":return
3180 if sl<2 then er=1:s$="no status":return
3190 if left$(s$,2)<>"00" then er=1
3200 return
3390 rem sub 3400: drain old uci data/status and wait for idle
3400 for w=1 to 20000
3410 zt=peek(cs)
3420 if (zt and 128)<>0 then x=peek(rd):goto 3410
3430 if (zt and 64)<>0 then x=peek(sd):goto 3410
3440 ss=zt and 48
3450 if (zt and 8)<>0 then poke cs,8:goto 3410
3460 if (zt and 4)<>0 then poke cs,4:goto 3410
3470 if ss=32 or ss=48 then poke cs,2:goto 3410
3480 if ss=0 and (zt and 1)=0 then return
3490 next w
3500 er=1:s$="sync timeout":return
4990 rem sub 5000: skip http headers until cr/lf/cr/lf, then body
5000 if hd=1 then gosub 6000:return
5010 if hm=0 and x=13 then hm=1:return
5020 if hm=1 and x=10 then hm=2:return
5030 if hm=2 and x=13 then hm=3:return
5040 if hm=3 and x=10 then hd=1:print "httpbin /get? json:":return
5050 if x=13 then hm=1:return
5060 hm=0:return
5990 rem sub 6000: print one body byte in readable c64 text
6000 if x=13 then return
6010 if x=10 then print:return
6020 if x=9 then print " ";:return
6030 if x=123 or x=91 then print:print "(";:bt=bt+1:return
6040 if x=125 or x=93 then print:print ")";:bt=bt+1:return
6050 if x=92 then print "/";:bt=bt+1:return
6060 if x=44 then print ",":return
6070 if x>=97 and x<=122 then x=x-32
6080 if x>=32 and x<=95 then print chr$(x);:bt=bt+1:return
6090 print ".";:bt=bt+1:return
6990 rem sub 7000: close tcp socket through uci network target
7000 c(0)=3:c(1)=9:c(2)=so:cl=3:gosub 3000:return