'By Fryer - Please Upload.
'GHB demo - R.Fryer

setup()
repeat gosub switch
gosub main
until (and(j1,8)>0)
end
label switch
    setdispbuf ss
    ss=1-ss
    setdrawbuf ss
    clear window
    j1=peek("port1")
    j2=peek("port2")
return
sub setup()
    open window 640,512
    ss=0
    dim sn(360),cs(360)
    for i=0 to 360
        sn(i)=sin(i/180*pi)
        cs(i)=cos(i/180*pi)
    next i
    dim map(20,20),h(20,20),c(20,20),r(20),b(20),g(20)
    dim map2(20,20)
    read mapx,mapy
    for i=1 to mapy
      for j=1 to mapx
        read map(j,i)
      next j
    next i
    for i=1 to mapy
      for j=1 to mapx
        read map2(j,i)
      next j
    next i
    for i=1 to mapy+1
      for j=1 to mapx+1
        h(j,i)=1+ran(2)
        c(j,i)=int(ran(20))
      next j
    next i
    for i=1 to 20
      r(i)=35+ran(40)
      g(i)=25+ran(10)
      b(i)=25+ran(10)
    next i
    ax=0
    ay=0
    mx=4
    my=4
    setrgb 0,0,70,0
    dim cx(200),cy(200),cxm(200),cym(200),cc(200),cnt(200)
    cars=40
    for i=1 to cars/2
cc(i)=int(ran(20))
cx(i)=(i-1)*80:cy(i)=-30:cxm(i)=1:cym(i)=0
j=i+cars/2
cc(j)=int(ran(20))
cx(j)=100+i*80:cy(j)=30:cxm(j)=-1:cym(j)=0
cnt(i)=150
cnt(j)=150
next i

end sub
label main
    gosub move
    gosub drawroad
    gosub drawcars
    gosub drawbridge
    gosub drawbuild
return

label drawcars
for i=1 to cars 
    carx=320+cx(i)+(ax-800*(mx-1))
    cary=256+cy(i)+(ay-800*(my-1))
    cxm=0:cym=0
    cnt(i)=cnt(i)+1
if cnt(i)<145 goto nochange
    cpx=int((1200+cx(i))/800)
    cpy=int((1200+cy(i))/800)
    map=map(cpx,cpy)
    rd=int(ran(2))
    if cxm(i)=1 then
        if mod(cx(i),800)=770 then
            if and(map,1)=1 then
                if and(map,6)=0 or rd=1 then
                    cxm=0
                    cym=-1
                fi
            fi
        fi
        if mod(cx(i),800)=30 then
            if and(map,4)=4 then
                if and(map,2)=0 or rd=1 then
                    cxm=0
                    cym=1
                fi
            fi
        fi
    fi
    if cym(i)=1 then
        if mod(cy(i),800)=770 then
            if and(map,2)=2 then
                if and(map,12)=0 or rd=1 then
                    cxm=1
                    cym=0
                fi
            fi
        fi
        if mod(cy(i),800)=30 then
            if and(map,8)=8 then
                if and(map,4)=0 or rd=1 then
                    cxm=-1
                    cym=0
                fi
            fi
        fi
    fi
    if cxm(i)=-1 then
        if mod(cx(i),800)=30 then
            if and(map,4)=4 then
                if and(map,9)=0 or rd=1 then
                    cxm=0
                    cym=1
                fi
            fi
        fi
        if mod(cx(i)+800,800)=770 then
            if and(map,1)=1 then
                if and(map,8)=0 or rd=1 then
                    cxm=0
                    cym=-1
                fi
            fi
        fi
    fi
    if cym(i)=-1 then
        if mod(cy(i),800)=30 then
            if and(map,8)=8 then
                if and(map,3)=0 or rd=1 then
                    cxm=-1
                    cym=0
                fi
            fi
        fi
        if mod(cy(i)+800,800)=770 then
            if and(map,2)=2 then
                if and(map,1)=0 or rd=1 then
                    cxm=1
                    cym=0
                fi
            fi
        fi
    fi
    if cxm+cym=0 goto nochange
    cxm(i)=cxm
    cym(i)=cym
    cnt(i)=0
label nochange
    sx=10+10*abs(cxm(i))
    sy=30-sx
    if carx>0 and carx<640 then
        if cary>0 and cary<512 then
            cc=cc(i)
            setrgb 1,r(cc),g(cc),b(cc)
fill rectangle carx-sx,cary-sy to carx+sx,cary+sy
        fi
    fi
    cx(i)=cx(i)+cxm(i)*5
    cy(i)=cy(i)+cym(i)*5
next i
return
label move
    ox=ax
    oy=ay

    ax=ax+and(j1,128)/16-and(j1,32)/4
    ay=ay+and(j1,16)/2-and(j1,64)/8

    ax=mod(ax+1200,800)-400
    ay=mod(ay+1200,800)-400
    if ax*ox<-100 mx=mx+ax/abs(ax)
    if ay*oy<-100 my=my+ay/abs(ay)
    map=map(mx,my)
    if and(map,8)=0 and ax>80 ax=ox
    if and(map,1)=0 and ay>80 ay=oy
    if and(map,2)=0 and ax<-80 ax=ox
    if and(map,4)=0 and ay<-80 ay=oy
    if abs(ax)>80 and abs(ay)>80 then
      if abs(ox)>80 ay=oy
      if abs(oy)>80 ax=ox
    fi
    x=ax+320
    y=ay+256
return

label drawroad
    x=ax+320
    y=ay+256
    map=map(mx,my)
    xmax=672
    xmin=-32
    ymax=544
    ymin=-32
    if and(map,1)=0 ymin=y-80
    if and(map,8)=0 xmin=x-80
    if and(map,4)=0 ymax=y+80
    if and(map,2)=0 xmax=x+80
    ex=mod(x+1280,800)-80
    ey=mod(y+1280,800)-80
    setrgb 1,50,50,50
    fill rectangle ex-100,y-100 to ex+100,y+100
    fill rectangle x-100,ey-100 to x+100,ey+100
    setrgb 1,80,80,80
    fill rectangle x-80,ymin to x+80,ymax
    fill rectangle xmin,y-80 to xmax,y+80
    setrgb 1,120,120,0
    fill rectangle x-50,ymin+30 to x+50,ymax-30
    fill rectangle xmin+30,y-50 to xmax-30,y+50
    setrgb 1,60,60,60
    fill rectangle x-49,ymin+32 to x+49,ymax-32
    fill rectangle xmin+32,y-49 to xmax-32,y+49
    setrgb 1,200,200,200
    if and(map,8)=8 then
        sl=0
        if and(map,5)=5 sl=-50
        if sl=-50line x-50,y to x-50,y-45
        for xl=x+sl to 0 step-50
            line xl,y to xl-25,y
        next xl
    fi
    if and(map,2)=2 then
        sl=50
        if and(map,5)=5 sl=100
        if sl=100 line x+50,y to x+50,y+45
        for xl=x+sl to 640 step 50
            line xl,y to xl-25,y
        next xl
    fi
    if and(map,1)=1 then
        sl=0
        if and(map,10)=10 sl=-50
        if sl=-50 line x,y-50 to x+45,y-50
        for yl=y+sl to 0 step-50
            line x,yl to x,yl-25
        next yl
    fi
    if and(map,4)=4 then
        sl=50
        if and(map,10)=10 sl=100
        if sl=100 line x,y+50 to x-45,y+50
        for yl=y+sl to 512 step 50
            line x,yl to x,yl-25
        next yl
    fi
setrgb 1,0,0,0
fill rectangle 315,251 to 325,261

return

label drawbridge
    map=map2(mx,my)
    if map=0 return
    xs=ax+320
    ys=ay+256
    x=ax*1.1+320
    y=ay*1.1+256
    xmax=672
    xmin=-32
    ymax=544
    ymin=-32
    if and(map,1)=0 ymin=y-80
    if and(map,8)=0 xmin=x-80
    if and(map,4)=0 ymax=y+80
    if and(map,2)=0 xmax=x+80
    setrgb 1,30,30,30
    fill rectangle xs-80,ymin to xs+80,ymax
    fill rectangle xmin,ys-80 to xmax,ys+80
    setrgb 1,80,80,80
    fill rectangle x-80,ymin to x+80,ymax
    fill rectangle xmin,y-80 to xmax,y+80
    setrgb 1,120,120,0
    fill rectangle x-50,ymin+30 to x+50,ymax-30
    fill rectangle xmin+30,y-50 to xmax-30,y+50
    setrgb 1,60,60,60
    fill rectangle x-49,ymin+32 to x+49,ymax-32
    fill rectangle xmin+32,y-49 to xmax-32,y+49
    setrgb 1,200,200,200
    if and(map,8)=8 then
        sl=0
        if and(map,5)=5 sl=-50
        if sl=-50line x-50,y to x-50,y-45
        for xl=x+sl to 0 step-50
            line xl,y to xl-25,y
        next xl
    fi
    if and(map,2)=2 then
        sl=50
        if and(map,5)=5 sl=100
        if sl=100 line x+50,y to x+50,y+45
        for xl=x+sl to 640 step 50
            line xl,y to xl-25,y
        next xl
    fi
    if and(map,1)=1 then
        sl=0
        if and(map,10)=10 sl=-50
        if sl=-50 line x,y-50 to x+45,y-50
        for yl=y+sl to 0 step-50
            line x,yl to x,yl-25
        next yl
    fi
    if and(map,4)=4 then
        sl=50
        if and(map,10)=10 sl=100
        if sl=100 line x,y+50 to x-45,y+50
        for yl=y+sl to 512 step 50
            line x,yl to x,yl-25
        next yl
    fi
return


label drawbuild
    h=h(mx,my)
    tx1=320+(ax-100)*h
    ty1=256+(ay-100)*h
    bx1=220+ax
    by1=156+ay
    h=h(mx+1,my)
    tx2=320+(ax+100)*h
    ty2=256+(ay-100)*h
    bx2=420+ax
    h=h(mx,my+1)
    tx3=320+(ax-100)*h
    ty3=256+(ay+100)*h
    by3=356+ay
    h=h(mx+1,my+1)
    tx4=320+(ax+100)*h
    ty4=256+(ay+100)*h
    setrgb 1,40,30,20
    fill triangle 0,ty1 to 0,by1 to bx1,by1
    fill triangle 0,ty1 to bx1,by1 to tx1,ty1
    fill triangle tx1,0 to bx1,0 to bx1,by1
    fill triangle tx1,0 to bx1,by1 to tx1,ty1
    fill triangle 640,ty2 to 640,by1 to bx2,by1
    fill triangle 640,ty2 to bx2,by1 to tx2,ty2
    fill triangle tx2,0 to bx2,0 to bx2,by1
    fill triangle tx2,0 to bx2,by1 to tx2,ty2
    fill triangle 0,ty3 to 0,by3 to bx1,by3
    fill triangle 0,ty3 to bx1,by3 to tx3,ty3
    fill triangle tx3,512 to bx1,512 to bx1,by3
    fill triangle tx3,512 to bx1,by3 to tx3,ty3
    fill triangle 640,ty4 to 640,by3 to bx2,by3
    fill triangle 640,ty4 to bx2,by3 to tx4,ty4
    fill triangle tx4,512 to bx2,512 to bx2,by3
    fill triangle tx4,512 to bx2,by3 to tx4,ty4
    c=c(mx,my)
    setrgb 1,r(c),g(c),b(c)
    fill rectangle 0,0 to tx1,ty1
    c=c(mx+1,my)
    setrgb 1,r(c),g(c),b(c)
    fill rectangle 640,0 to tx2,ty2
    c=c(mx,my+1)
    setrgb 1,r(c),g(c),b(c)
    fill rectangle 0,512 to tx3,ty3
    c=c(mx+1,my+1)
    setrgb 1,r(c),g(c),b(c)
    fill rectangle 640,512 to tx4,ty4
    setrgb 1,60,50,40
    line bx1,by1 to tx1,ty1
    line bx2,by1 to tx2,ty2
    line bx1,by3 to tx3,ty3
    line bx2,by3 to tx4,ty4
setrgb 1,0,0,0
a$=str$(ax)+" "+str$(ay)
text 100,100,a$
return
data 8,7
data 06,10,10,14,14,10,10,12 
data 07,10,12,05,05,00,06,09
data 05,00,07,15,13,00,05,00
data 03,10,11,11,11,10,11,12
data 00,00,00,06,10,12,00,05
data 06,14,10,15,10,09,00,05
data 03,09,00,03,10,10,10,09

data 00,05,00,00,00,00,00,00
data 00,05,00,00,00,00,00,00
data 00,05,00,00,00,00,00,00
data 00,05,00,00,00,00,00,00
data 00,03,12,00,00,00,00,00
data 00,00,05,00,00,06,10,10
data 00,00,05,00,00,05,00,00