.TITLE  VPSYM
        .GLOBL  VPSYM
ANPTS=0
ATYPE=2
AXA=4
AXMIN=4
AXF=6
AXI=8.
ADELX=6
AYA=10.
AYF=12.
AYI=14.
AEA=16.
AJOIN=18.
AOFF=20.
AXP=22.
AYP=24.
AEP=26.
AXC=28.
AYC=30.
AEC=32.
AXN=34.
AYN=36.
AEN=38.
AIC=40.
        .PSECT  VXDES,RW,D,GBL,REL,OVR
XFAC:   .BLKW   2
XOFF:   .BLKW   2
XTYPE:  .BLKW   1
XMAXB:  .BLKW   1
XSMINB: .BLKW   1
XSMAXB: .BLKW   1
XSNOWB: .BLKW   1
        .PSECT
        .PSECT  VYDES,RW,D,GBL,REL,OVR
YFAC:   .BLKW   2
YOFF:   .BLKW   2
YTYPE:  .BLKW   1
YMINB:  .BLKW   1
YMAXB:  .BLKW   1
        .PSECT
R0=%0
R1=%1
R2=%2
R3=%3
R4=%4
R5=%5
SP=%6
PC=%7
        .GLOBL  VBSET,VSBSET,VGETXY,VSETBC
XL:     .WORD   0
YL:     .WORD   0
EL:     .WORD   0
XH:     .WORD   0
YH:     .WORD   0
EH:     .WORD   0
ID:     .WORD   0
ARG1:   .WORD   0
ARG2:   .WORD   0
ARG3:   .WORD   0
ARG4:   .WORD   0
ARG5:   .WORD   0
ALST1:  .BYTE   1,0
        .WORD   ARG1
ALST2:  .BYTE   1,0
        .WORD   ARG2
ALST3:  .BYTE   2,0
        .WORD   ARG1,ARG2
ALST4:  .BYTE   3,0
        .WORD   ARG1,ARG2,ARG3
ALST5:  .BYTE   5,0
L1204:  .WORD   0,ID,XH,YH,EH
ALST6:  .BYTE   5,0
A1:     .WORD   0
        .WORD   ARG2
A3:     .WORD   0
A4:     .WORD   0
A5:     .WORD   0
A=R0
YLOW=R1
YHIGH=R2
YP=R1
VPSYM:  MOV     R5,-(SP)
        MOV     2(R5),A
        MOV     AXC(A),XL
        MOV     AYC(A),YL
        MOV     AEC(A),EL
        MOV     AXN(A),XH
        MOV     AYN(A),YH
        MOV     AEN(A),EH
        MOV     AIC(A),ID
        INC     ID
L1000:  CMP     YL,YMINB
        BLT     L1200
        CMP     YL,YMAXB
        BGT     L1200
        TST     AEA(A)
        BEQ     L1100
        MOV     YL,YLOW
        MOV     YLOW,YHIGH
        SUB     EL,YLOW
        ADD     EL,YHIGH
        CMP     YLOW,YMINB
        BGE     L1002
        MOV     YMINB,YLOW
L1002:  CMP     YLOW,YMAXB
        BLE     L1004
        MOV     YMAXB,YLOW
L1004:  CMP     YHIGH,YMINB
        BGE     L1006
        MOV     YMINB,YHIGH
L1006:  CMP     YHIGH,YMAXB
        BLE     L1008
        MOV     YMAXB,YHIGH
L1008:  MOV     YHIGH,R3
        SUB     YLOW,R3
        CMP     R3,#6
        BLT     L1100
        MOV     YLOW,ARG1
        MOV     YHIGH,ARG2
        CMP     XSNOWB,XL
        BEQ     L1020
        MOV     #ALST1,R5
        JSR     PC,VSBSET
        MOV     #ALST2,R5
        JSR     PC,VSBSET
        BR      L1100
L1020:  MOV     YHIGH,-(SP)
        MOV     YL,ARG2
        SUB     #3,ARG2
        MOV     #ALST3,R5
        JSR     PC,VBSET
        MOV     (SP)+,ARG2
        MOV     YL,ARG1
        ADD     #3,ARG1
        MOV     #ALST3,R5
        JSR     PC,VBSET
L1100:  MOV     YL,YP
        MOV     (SP),R5
        MOV     2(R5),A
        CMP     YP,YMINB
        BGE     L1102
        MOV     YMINB,YP
L1102:  CMP     YP,YMAXB
        BLE     L1104
        MOV     YMAXB,YP
L1104:  TSTB    AJOIN(A)
        BEQ     L1200
        MOVB    AJOIN(A),ARG1
        CLRB    ARG1+1
        MOV     XSNOWB,R3
        SUB     XL,R3
        MOV     R3,ARG2
        MOV     YP,ARG3
        MOV     #ALST4,R5
        JSR     PC,VSETBC
        MOV     (SP),R5
        MOV     2(R5),A
L1200:  MOV     XSNOWB,R3
        ADD     #2,R3
        CMP     XH,R3
        BGT     L2000
        CMP     ID,ANPTS(A)
        BGT     L2000
        MOV     XH,XL
        MOV     YH,YL
        MOV     EH,EL
        INC     ID
        MOV     A,L1204
        MOV     #ALST5,R5
        JSR     PC,VGETXY
        MOV     (SP),R5
        MOV     2(R5),A
        JMP     L1000
L2000:  MOV     AXC(A),R3
        ADD     #2,R3
        CMP     XSNOWB,R3
        BLT     L3000
        CMP     AIC(A),ANPTS(A)
        BGE     L2030
        MOV     A,R1
        ADD     #AXP,R1
        MOV     R1,R2
        ADD     #6,R2
        MOV     (R2)+,(R1)+
        MOV     (R2)+,(R1)+
        MOV     (R2)+,(R1)+
        MOV     (R2)+,(R1)+
        MOV     (R2)+,(R1)+
        MOV     (R2)+,(R1)+
        INC     AIC(A)
        MOV     AIC(A),ARG2
        INC     ARG2
        MOV     A,A1
        MOV     A,A3
        MOV     A,A4
        MOV     A,A5
        ADD     #AXN,A3
        ADD     #AYN,A4
        ADD     #AEN,A5
        MOV     #ALST6,R5
        JSR     PC,VGETXY
        MOV     (SP),R5
        MOV     2(R5),A
        BR      L2000
L2030:  MOV     A,R1
        ADD     #AXP,R1
        MOV     #9.,R2
L2040:  MOV     #77777,(R1)+
        DEC     R2
        BNE     L2040
L3000:  MOV     (SP)+,R5
        RTS     PC
        .END