;GPRIMS taken from TP01_all_macros.txt
;GPRIMS 4/10/76
; Primitives updated from 61.pdf "Blue tape" 12/8/77
PRIM ' 1, PRIM = 2, PRIM OR 3, PRIM AND 4, PRIM NOT 5
PRIM LT 6, PRIM LE 7, PRIM EQ 8, PRIM NE 9, PRIM GE 10, PRIM GT 11
PRIM + 12, PRIM - 13, PRIM * 14, PRIM / 15, PRIM EXP 16
;new value for TYPE
PRIM TYPE 17
PRIM $ 20
PRIM GO 21, PRIM AV 22, PRIM @ 23, PRIM CY 24, PRIM FNTH 25
PRIM FIND 26, PRIM RP 27, PRIM : 28, PRIM NEW 29, PRIM OLD 30
;PRIM IF 31, PRIM TYPE 32, 
PRIM IF 32
PRIM ABUG 33, PRIM ITMS 34, PRIM GRPS 35
PRIM LNS 36, PRIM RHA 37, PRIM LINA 38, PRIM CLA 39
PRIM READ 40
;PRIM GRIN 42, PRIM AIN 43
;PRIM LEFT 46, PRIM GARB 47
PRIM GRIN 41
PRIM AIN 42
PRIM PROT 43
PRIM LOCAL 44
PRIM DIR 45
PRIM SS 47
PRIM LEFT 48
PRIM GARB 49
PRIM % 50
; new SRC
PRIM SRC 51
PRIM DEST 52, 
;  APTO and CRF not in this version
;PRIM APTO 53, PRIM CRF 54
; RES not in this version
;PRIM RES 55, 
PRIM SAVE 56, PRIM NAME 57
;, PRIM SS 58
;new
PRIM ALFA 58
PRIM OP 60, PRIM NUTR 61, PRIM DNTR 62, PRIM UPTR 63, PRIM FIG 64
PRIM MOVE 65, PRIM SCALE 66, PRIM ROT 67, PRIM ROTX 68, PRIM ROTY 69
;PRIM UNITY 71,PRIM LIN 72
PRIM UNITY 70, PRIM LIN 71, PRIM HARM 72
;new
PRIM ARC0 73, PRIM TREE 74, PRIM SETCOL 75
PRIM COLR 77, PRIM FAD0 78, PRIM LEVEL 79
;PRIM ARC0 78, PRIM TREE 79, 
PRIM PERSP 80, PRIM EXIT 90, PRIM EXTR 91
PRIM STOP 100
; user defined primitives, start group, end group used at start,end frame
PRIM SG 101
PRIM EG 102
:NL<<^>>, :PRINT<##(OP)>, PRINT"PRIMITIVES LOADED"
; then has PROT(DIR) not sure what that does, omitted
;PROT(DIR)
; added DFLT and ARG1 from TP01_all movier
:DFLT[:#1(ARG1#2(@#1 CY 1)0)]
:ARG1<#1>
;VIEWER 2/9/77 from 61.pdf
)"WAIT FOR VIEWER TO LOAD"(OP
;OLD((CSYS)),:CSYS VIEWER
;:VIEWER VIEWER PICTURE PIC ADPIC DEPIC ANIM CH THEN HOLD AFTER AFTALL(
;    )END NEWQ SSQ EXFR ESEQ RSTQ VIEW VU0 NFR SEC MSEC F B T
:PICTURE[:TRTP#1]
:PIC[DNTR,##,UPTR]
:ABT[:II 0, @-1 1,MOVE(ABT0),(CY 7),MOVE($(-II))]
:ABT0[-(CY 1),'II=II+1,GO((AV 1 TYPE)EQ 1)ABT0]
:ANIM[:ANM0[SSQ#0>#1(SFNO,CEFN#2##)<]]
:SSQ[#2##(FNO),EXIT(#4 GT FNO),RP(RHA(@#1 FIND(SS 4))),UNITY]
:CEFN[+EFNO=SFNO+(NFR##),EXIT(+EFNO LE FFNO),'FFNO=EFNO]
:CH[IF(RHA(@#1 FIND(SS 4)))[@(RHA)],:#1(CY "ZZ", CY ANM0)#2##]
:THEN[:SFNO(EFNO),GO NEWQ]
:AFTER[:SFNO((NFR##)+SFNO),GO NEWQ]
:AFTALL[:SFNO(FFNO),GO NEWQ]
:OFF [NEW #1, @OLST :0 #1, PRIM #1 46]
:ON [OLD(@(@OLST FIND #1) CY I), :I]
:OLST
:FADE (NEW #1 (FAD1 #1 (CEFN##) OFF0 (EFNO) -), @OLST :0 #1)
:MIXON [EXIT(@(@OLST FIND #1),NOT TYPE)
  OLD#1, NEW#1(FAD1 #1 (CEFN##) ON0 (-SFNO) +)]
:FAD1 <[GO( >#2< LE FNO) >#3<](
      CY#1) [FAD0( >#4#5< FNO) >(+EFNO-SFNO)< ]>
:OFF0[PRI #0 46]
:ON0[ON #0, GO #0]
:HOLD['SFNO=FFNO-1,NEWQ,'SFNO=FFNO+(NFR##),'EFNO=SFNO
      IF(+FNO LT SFNO)['FNO=SFNO],GO NEWQ]
:NEWQ[IF(+SFNO GT FFNO)['FFNO=SFNO],EXIT(+FNO GE SFNO,BCK)
      EXFR,GO QLOG]
:EXFR[SG(FNO),NUTR,PIC(TRTP),EXTR(FR),EG,NFNO,GO(+FNO LE SFNO)EXFR]
:FILM[NEW NFNO['FNO=(+LFNO=FNO)+FREP],RSOL
      :FNO 2,SEQ0##,RSOL,OLD NFNO]
:FREP 2
:VIEW[:FNO 0,:FNO(NFR(READ"?")),GO VU0]
:VU0[RSOL,OFF QLOG,:QLOG,OFF FR,SEQ0##,GO(-BCK)VU0
  PRINT"SEQUENCE ENDS AT FRAME "(FFNO),GO VIEW]
:RSOL[OLD(OLST),:OLST]
:SEQ0[:BCK,:SFNO 0,:EFNO 0,:FFNO 0,:LFNO 0,##,END]
:END['SFNO=FFNO,GO NEWQ]
:NFNO[PRINT" "(NL)"FRAME "(FNO)
  :BCK(IF((FNO)GT(+FNO=(NFR(READ"?"))))2)
  EXIT(0 LE FNO),:FNO 1]
:FR[+FNO-LFNO]
:NFR[(1+FNO,#2#1)+(#4#3)]
:SEC[#1*25]
:MSEC[#1/40]
:F[#1+FNO]
:B[+FNO-#1]
:T[NEW EXFR[OLD EXFR,EXIT "ZZ"]]
:QLOG[PRINT(FNO)#0##]
;)"LOADED"(OP,SRC 0,VIEW
)"LOADED"(OP
PRINT"STACK LEFT "(LEFT)


:RING  146!5399     0  5379   470  5317   937  5215  1397 (
       )   5074  1846  4894  2282  4676  2699  4423  3097 (
       )   4136  3471  3818  3818  3471  4136  3097  4423 (
       )   2700  4676  2282  4894  1846  5074  1397  5215 (
       )    937  5317   470  5379     0  5399  -470  5379 (
       )   -937  5317 -1397  5216 -1846  5074 -2282  4894 (
       )  -2699  4676 -3097  4423 -3471  4136 -3818  3818 (
       )  -4136  3471 -4423  3097 -4676  2700 -4894  2282 (
       )  -5074  1846 -5215  1397 -5317   937 -5379   470 (
       )  -5399     0 -5379  -470 -5317  -937 -5216 -1397 (
       )  -5074 -1846 -4894 -2282 -4676 -2699 -4423 -3097 (
       )  -4136 -3471 -3818 -3818 -3471 -4136 -3097 -4423 (
       )  -2700 -4676 -2282 -4894 -1846 -5074 -1397 -5215 (
       )   -937 -5317  -470 -5379     0 -5399   470 -5379 (
       )    937 -5317  1397 -5216  1846 -5074  2282 -4894 (
       )   2699 -4676  3097 -4423  3471 -4136  3818 -3818 (
       )   4136 -3471  4423 -3097  4676 -2700  4894 -2282 (
       )   5074 -1846  5215 -1397  5317  -937  5379  -470 (
       )   5399     0 !5199     0  5180   453  5120   902 (
       )   5022  1345  4886  1778  4712  2197  4503  2599 (
       )   4259  2982  3983  3342  3676  3676  3342  3983 (
       )   2982  4259  2600  4503  2197  4712  1778  4886 (
       )   1345  5022   902  5120   453  5180     0  5199 (
       )   -453  5180  -902  5121 -1345  5022 -1778  4886 (
       )  -2197  4712 -2599  4503 -2982  4259 -3342  3983 (
       )  -3676  3676 -3983  3342 -4259  2982 -4503  2600 (
       )  -4712  2197 -4886  1778 -5022  1345 -5120   902 (
       )  -5180   453 -5199     0 -5180  -453 -5121  -902 (
       )  -5022 -1345 -4886 -1778 -4712 -2197 -4503 -2599 (
       )  -4259 -2982 -3983 -3342 -3676 -3676 -3342 -3983 (
       )  -2982 -4259 -2600 -4503 -2197 -4712 -1778 -4886 (
       )  -1345 -5022  -903 -5120  -453 -5180     0 -5199 (
       )    453 -5180   902 -5121  1345 -5022  1778 -4886 (
       )   2197 -4712  2599 -4503  2982 -4259  3342 -3983 (
       )   3676 -3676  3983 -3342  4259 -2982  4503 -2600 (
       )   4712 -2197  4886 -1778  5022 -1345  5120  -903 (
       )   5180  -453  5199     0
:PRB2 20!1800    800   800  1800  2000  3000  3000  2000  1800   800 (
     )  ! -800  1799 -1800   799 -3000  1999 -2000  2999  -800  1799 (
     )  !-1799  -800  -799 -1800 -1998 -3000 -2999 -2001 -1799  -800 (
     )  !  801 -1799  1800  -798  3001 -1997  2002 -2998   801 -1799 

:RSEG 92!4100   1000  3948  1489  3739  1956  3475   2394  3159  2797 (
     )   2797   3159  2394  3475  1956  3739  1489   3948  1000  4100 (
     )   1000   5000  1527  4864  2038  4673  2525   4429  2983  4135 (
     )   3407   3793  3793  3407  4135  2983  4429   2525  4673  2038 (
     )   4864   1527  5000   999  4100  1000!-1000   4099 -1489  3947 (
     )  -1956   3738 -2394  3474 -2797  3158 -3159   2796 -3475  2393 (
     )  -3739   1955 -3948  1488 -4100   999 -5000    998 -4864  1525 (
     )  -4673   2036 -4429  2523 -4135  2981 -3793   3406 -3407  3792 (
     )  -2984   4134 -2526  4428 -2039  4672 -1528   4863 -1000  4999 (
     )  -1000 4099!-4099   -1001 -3947 -1490 -3738  -1957 -3473 -2395 (
     )  -3157  -2798 -2795 -3160 -2392 -3476 -1954  -3739 -1487 -3948 (
     )   -998  -4100  -997 -5000 -1524 -4864 -2035  -4673 -2522 -4430 (
     )  -2980  -4136 -3405 -3794 -3791 -3408 -4133  -2985 -4427 -2527 (
     )  -4672  -2040 -4863 -1529 -4999 -1001 -4099  -1001!1002  -4099 (
     )   1491  -3946  1958 -3737  2396 -3473  2799  -3156  3161 -2794 (
     )   3476  -2391  3740 -1953  3949 -1486  4100   -997  5000  -996 (
     )   4865  -1523  4674 -2034  4430 -2521  4137  -2979  3795 -3404 (
     )   3409  -3790  2986 -4132  2528 -4427  2041  -4671  1530 -4862 (
     )   1002  -4999  1002 -4099

:PRB1 50!-1800  -800 -1800   800  -800  1800   800  1800  1800   800 (
     )    1800  -800   800 -1800  -800 -1800 -1800  -800!1299      0 (
     )    1283   203  1236   401  1158   590  1051   764   919   919 (
     )     764  1051   590  1158   401  1236   203  1283     0  1299 (
     )    -203  1283  -401  1236  -590  1158  -764  1051  -919   919 (
     )   -1051   764 -1158   590 -1236   401 -1283   203 -1299     0 (
     )   -1283  -203 -1236  -401 -1158  -590 -1051  -764  -919  -919 (
     )    -764 -1051  -590 -1158  -401 -1236  -203 -1283     0 -1299 (
     )     203 -1283   401 -1236   590 -1158   764 -1051   919  -919 (
     )    1051  -764  1158  -590  1236  -401  1283  -203  1299     0

:RDOK 35! 1800  -800  4400  -600 (
) ! 1800  -600  2000   600 (
) ! 1800   600  4400   800 (
) ! 4200  -600  4400   600 (
) ! -800  1800   800  2000 (
) ! -800  2000  -600  4200 (
) ! -800  4200   800  4400 (
) !  600  2000   800  4200 (
) !-4400  -800 -1800  -600 (
) !-4400  -600 -4200   600 (
) !-4400   600 -1800   800 (
) !-2000  -600 -1800   600 (
) ! -800 -4400   800 -4200 (
) ! -800 -4200  -600 -2000 (
) ! -800 -2000   800 -1800 (
) !  600 -4200   800 -2000

:RLOX 35! 1800  -800 4400 -600 (
) ! 1800  -600  2000   600 (
) ! 1800   600  4400   800 (
) ! 4200  -600  4400   600 (
) ! -800  1800   800  2000 (
) ! -800  2000  -600  4200 (
) ! -800  4200   800  4400 (
) !  600  2000   800  4200 (
) !-4400  -800 -1800  -600 (
) !-4400  -600 -4200   600 (
) !-4400   600 -1800   800 (
) !-2000  -600 -1800   600 (
) ! -800 -4400   800 -4200 (
) ! -800 -4200  -600 -2000 (
) ! -800 -2000   800 -1800 (
) !  600 -4200   800 -2000 

:NLOX 40! 1800 -800 1800 800 4400 800 4400 -800 1800 -800 (
) ! 2000  -600  2000   600  4200   600  4200  -600  2000   -600 (
) !  799  1800  -800  1799  -801  4399   798  4400   799   1800 (
) !  599  2000  -600  1999  -601  4199   598  4200   599   2000 (
) !-1800   799 -1799  -800 -4399  -802 -4400   797 -1800    799 (
) !-2000   599 -1999  -600 -4199  -602 -4200   597 -2000    599 (
) ! -798 -1800   801 -1799   803 -4399  -796 -4400  -798  -1800 (
) ! -598 -2000   601 -1999   603 -4199  -596 -4200  -598  -2000 

:DOCKA 20!-800  -5000  800 -5000  800 -4600 -800 -4600 -800 -5000 (
) ! -5000   -800  -5000  800 -4600  800 -4600 -800 -5000 -800 (
) !  -800   4600    800 4600   800 5000  -800 5000  -800 4600 (
) !  4600   -800   4600  800  5000  800  5000 -800  4600 -800

:DOCKB1 20!-600 -2800 600 -2800 600 -2000 -600 -2000 -600 -2800 (
) ! -2800   -600 -2800    600 -2000   600 -2000  -600 -2800  -600 (
) !  -600   2800   600   2800   600  2000  -600  2000  -600  2800 (
) !  2000   -600  2000    600  2800   600  2800  -600  2000  -600 

:DOCKB2 20!-600 -4200 600 -4200   600 -3400  -600 -3400 -600 -4200 (
) ! -4200   -600  -4200     600 -3400   600 -3400  -600 -4200 -600 (
) !  -600   4200    600    4200   600  3400  -600  3400  -600 4200 (
) !  3400   -600   3400     600  4200   600  4200  -600  3400 -600 

PRINT"STACK LEFT "(LEFT)

:BURN[PICTURE DOCKS
:D1 1 1
:D2 100 100
AFTER 1
ANIM LIN 1
CH D1 100 100
CH D2 1 1
]
:DOCKS [
FIG RING
FIG PRB2
FIG PSEG
FIG PRB1
FIG NLOX
FIG DOCKA
PIC DOCK1
PIC DOCK2
  ]
:DOCK1[FIG DOCKB1
SCALE(D1)
   ]

:DOCK2[FIG DOCKB2
SCALE(D2)
   ]

VIEW BURN
1
2
3
T
STOP