\ system load screen for FFT                          rfg12sep84                                                                7 34 thru                                                       \ 6 load                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                        ( add common tools to PCforth  game system           12/28/83 )  FORTH DEFINITIONS DECIMAL                                      : sb save-buffers ;                                             \ : ?FIND  FIND ; IMMEDIATE                                                                                                     : IFSO  NOT IF [COMPILE] \ THEN ; IMMEDIATE                     : IFNOT NOT [COMPILE] IFSO ; IMMEDIATE                                                                                          : !CSP SP@ CSP ! ;                                              : :: HERE >R  [ ' QUIT CFA @ ] LITERAL ,  !CSP                      ] BEGIN INTERPRET STATE @ WHILE CR QUERY REPEAT                 SMUDGE R@ 2+ EXECUTE R> DP ! ;                               DECIMAL                                                                                                                                                                                                                                                        \ sawtooth array                                      rfg12sep84decimal                                                         64 100 xvector sawtooth                                                                                                         : saw sawtooth 8 +                                                    64 0 do i 100 * over i 4 * + ! loop drop ;                                                                                saw                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                             \ data for IBM over 1983, by week                     rfg12sep84                                                                100 64 xvector IBM                                              9663   9913   9463   9738   9738   9638   9863   10038          10224  10075  9988   10213  10163  10388  11013  11725          11700  11763  11650  11063  11300  11400  11425  12113          12300  12100  12150  12013  12438  12038  12975  11850          12250  11783  11975  12225  12313  12663  12688  13225          13175  12700  12800  12225  12688  12350  12100  11788          12225  12088  12363  12200  0      0      0      0              0      0      0      0      0      0      0      0                                                                              100 64 ibm vector!                                              \  ibm fft ibm plotmag                                                                                                                                                                          \ square and square root                              rfg12sep84( from Klaxon Suralis, via 4th Dimensions )                     : d2* 2dup d+ ;                                                                                                                 : easy-bits                                                       0 do >r d2* d2* r@ - dup 0<                                         if r@ + r> 2* 1-                                                else    r> 2* 3 +                                               then loop ;                                                                                                               : 2's-bit                                                         >r d2* dup 0<                                                   if d2* r@ - r> 1+ else d2* r@ 2dup u<                             if drop r> 1- else - r> 1+ then                               then ;                                                                                                                        \ sqr and sqrt                                        rfg12sep84                                                                : 1's-bit                                                          >r dup 0<                                                        if 2drop r> 1+                                                  else d2* 32768 r@ du< 0= r> +                                   then ;                                                                                                                      : sqrt                                                             0 1 8 easy-bits rot drop 6 easy-bits                            2's-bit 1's-bit ;                                                                                                            : sqr dup m* ;                                                                                                                                                                                                                                                  \ complex data types and operations                   rfg12sep842 constant wsize \ i guess                                      : x@ 2@ ;                                                       : x! 2! ;                                                                                                                       : xvariable                                                         create wsize 2* here over  \ two elements per complex #                0 fill allot                                             does> ;                                                                                                                     : xconstant  \ x ---                                                create here wsize 2* 2dup                                              0 fill allot x!                                          does> x@ ;                                                                                                                                                                                  \ complex stack words                                 rfg12sep84                                                                : xdup   2dup ;                                                 : xswap  2swap ;                                                : xdrop  2drop ;                                                : xover  2 over ;                                               : x2dup  2over 2over ;                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                          \ complex add,subtract,magnitude                      rfg12sep84                                                                : x+ rot + >r + r> ;                                            : x- rot swap - >r - r> ;                                       : x2/ 2/ swap 2/ swap ;                                         : |x|^2 sqr rot sqr d+ ;                                        : |x| |x|^2 sqrt ;                                              : x' swap negate swap ;                                         : x0= 0= swap 0= and ;                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                          \ complex multiply                                    rfg12sep84                                                                : x*                                                               >r x2dup                                                        rot r@ */                                                       rot rot r@ */ -                                                 r> swap >r >r                                                   rot rot r@ */                                                   rot rot r> */ +                                                 r> ;                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                         \ more complex operations                             rfg12sep84                                                                : x*!                                                              over >r >r                                                      x@ rot x@ r>                                                    x*  r> x! ;                                                                                                                  : x/  >r xswap xover                                                  x' r@ x*                                                        xswap |x| dup r@ */                                             swap over r@ swap */                                            rot rot r> swap */ swap ;                                                                                                                                                                                                                                                                                                 "	�t�1)/"	�t)/^�t 
�POLY-W�Z����9� 
_��@CR�Z�_{�_{�_{�_{�_{�a{
b{�]{�]{�_{�_{ 
.��!CR�Z�_�t�_�t�]�t�]�t
b�t�a�t�_�t�_�t�_�t�_�t�_�t 
ҏ�$�Z�
-,�
�(� 
���POLY-E�Z�&�&3��_{-,)/�	�_{Z71�1)/�"	�1"�j� 
���POS.PX�Z�&�&�&�&3��1�1�1�1Z7Q���j� 
e��WINDO�Z-,Vb�t)/��1-,<b�t"	0b�t-,Ib�t�
)/���)/�	1"	#b�tb�t 
Z�&3�O�_�t��<b{#b{)/"	Q��1��j� 
Z�&3�O�_�t��<b{b{Q��1��j� 
瑈WLINE-�Z)/O�<b{b{�
0b{#b{�
<b{b{%��T� 
��WLINE-�Z)/O�<b{b{�
0b{#b{<b{b{%��z� 
ۍ�GC�Z)/���_�t<b{�_�t 
���WSHORT�ZVb{Z7)/#b�t#b{<b{�)/��Ib�t 
֒�CTINI�Z��O�_�t�V
} 
��CTWIND�Z)/2)/)/)/&� 
X��CTPOS�Z>+jb�t`b�tZ7)/�)/"	)/2�1)/��	Q� 
q��CTERAS�Z�]{)/3)/])/��W"�OO��
} 
(��CTC�ZOjb{�
)/�0�� 
�TTY-SC�Z)/O�)/)/1)/�)/)/)/2%�� 
Ɠ�.TT�Z���O)/��� 
���VIEWSC�Z)/O�
.�
)/�1)/Dh�)/L
."	)/�1)/Dh��%��)/O�)/)/D
."	)/K1h�)/)/�
."	)/1h�)/K)/�
."	)/D1h��%��)/J)/�)/1h� 
ZlO�
.�
O1)/4h�)/�
."	O1)/4h��%��)/)/4)/�)/4h�)/O)/�Oh� 
ZlO�)/Q
."	)/}1)/�h�)/�
."	)/}1)/�h��%��)/S)/�)/�)/�h�)/S)/})/�)/}h� 
ZlO�)/Z
."	)/71)/zh�)/�
."	)/71)/zh��%��)/\)/z)/�)/zh�)/\)/7)/�)/7h� 
Z�[�_�t)/	�_�t)/�_�tO�_�t�R�_�t)/O�)/Q)/x
.)/��	Q�全%��)/)/A�Vf� 
A��SAVE-S�Z�]{�]{� 

��SCR-RE�Z�]{�]{� 
Z�&�]{)/y)/\)/8)/��1"�
} 
��ERASE-�Z�&�]{)/�)/S)/~)/��1"�
} 
^��ERASE-�Z�&�]{)/3)/])/��1"�OO��
} 
Z�]{Z7
}+��O���
} 
Z��YBUTTO�Z)/�)/R)/w�1�	Q�
}O�_�t 
��.HIGHL�Z�R�_�t��[�_�t)/�_�t)/�_�t� 
.��.O�Z�R�_�t�)/���_�tl�_�t)/�_�tl�_�t
\�_�t� 
Z)/O�O
.>+6�`��%�� 
���INIT-B�Z��O�a�tWO6� 
���SHIP-C�Z�V
}炍W
}b�<�����Ot�O������ 
F��'KE�Zp�
*p�
��b�t}(���b{�e�*�e�t��*�e�t}(O 
Z])/�� 
Z]O 
Z]] 
ZO)/�� 
ZO]�bu 
Z)/��)/�� 
Z)/��O 
Z)/��] 
ZOO 
ZOO�bu 
\��(XYSCA�#r	��G
3�H
=�I
E�K
M�M
W�O
c�P
o�Q
y���ȗ�XYSCA�Z�bu�bu���� 
���?TRI�Z�b{-,�
�bu 
䘅?QUI�Z�b{-,�
�bu 
���Y/�ZҘZ7,Q'�
���
 
Z)/]�_�t)/���_�t 
˘�CURSOR�Z�d{�_�tO 
���BLD-CR�Z�]{�&�b{
}L��_�t�_u�

b{)/�"	�&
.�(�_�t
.�
�(�_�t
.
�(�_�t�1)/"	�(�_�t养1
} 
���SET-CR�Z�a{1�(�
OZ7C�
.�a{
b{�&�0�
-,d��a{
b�td�]}(,O}(�(
b{�0Oi0-,
b�t�a�tO 
D��$�Z1�(�
5u 
&��$�Z]�1�1-,�(�
O�1
."	�(1
."	�(�&�
�
�1�0�1�1�.�%��,+ 
\��CHAR/��)@���LINE/��)7��L�%6LE��C�%6LEx��MOD�%6  ���'LIN�Z51)/P"	 
���CCO�Z��{ 
���LIN�Z��{ 
���(GO�Zl"	Z7)/"	� 
���GG�ZO)/�Ț�	Țך� 
ᚄHOM�ZO���tO���t 
��+�Zך�
���0���t 
Ú�-�Zך�
Oi0���t 
-��+�ZȚ�
��
�0���t 
B��-�ZȚ�
Oi0���t 
n��LA�Z���{�u"	 
���CLA�Zך�� 
Қ�<ADD�Z��Ț"	 
���COL�Z�Ț�	 
���LINE�Z��ך�	 
���.>EO�Z����� 
W��.BLOC�Zךћ-,�
�
O�-,O1暇����
�%��, 
ݛ�P�Z��tȚך������t���t])/��{�	 
���CLR�Z-,���`(muOZ7��;7 
"��-LIN�Z����`(mu��;7 
l��-BLOC�Zr�ךћO��
-,R��%��, 
���.MOD�Z)/)/H���{�
�Insert }(�Replace 
M��DISPLA�Z)/O��21:SV-BUF 2:RCL  3:IL  4:XL  5:DUP  6:SPLIT  7:>L  �8:>S  9:HOLD 10:PUT�� 
˛�CLEA�Z)/O�)/O;7)/O� 
ݜ�M�ZZ7��-,�1"	�5u 
@��MLD�Z�e� 
y��MLU�Z��0e� 
���LHOL�Z�����(5u 
b��(DUPL�ZћQ'�
O�)/
.�	~��%�� 
INS�Z��ךR��� 
���DUP�Z���� 
睅SPLI�Zћ�
��r����"	Ț`(muך0������t 
���X�Z��ћQ'�
O�ך
."	�
���%�������`(mu�� 
"��X�Z��-,-,�
Z7���
5u`(Z7���
"	�t� 
���INSER�Z-,���{�
*���
�
��-,-,�
���
Ju�tZ��}(���t}(���tZ� 
S��DELET�Zq�����{�
V�}(
`(���t*7 
z��?VISIB�Z-,-,)/�&Z7)/�~=( 
���EO�Z����	-,�
�
)/?�0���t, 
���PU�Z�O���
."	�(��0�
�1�1,+{ 
,�%����{-,�
�������5uV$�
��}(ȚO���t��㛞��t 
��CARRE�ZO���t0� 
���TAB�ZZ�Z�Z� 
���ES�ZF�Vzx1 
���RECAL�Z�$O%� 
螂U�Z]%� 
ğ�DOW�Z)/��%� 
ԝ�/MOD�Z��{�0���t�� 
䟅STAM�%6���USER-I�%6ALLOT ID�Z��ID�Z!�)/`(mu�A)/
�0!�Z75u\# 
2��>STAM�Z�{�
!��{�u)/2"	)/
5u\# 
ן�EDIT-K�#rT;G
�=
۝ʞP
2�?
�	��H
G�@
����M
\�>
'�<
͟K
s�S
X�I
ܟA
t�O
�Q
�B
��D
4�R
��C
��
��;
_�
��EDI�Z���.�����
��}(��}(�� 
�ECH�%6���CO�%6%��LP�%6
V��'PCRL�%6����PPREVC�%6.��ECHO�Z�{ 
/��PRINT�Z)�{3�{�0 
F��EOL�ZN�{��&Z��
=( 
9��MKPRIN�Z-,)/�&1)/�~=(�0�
,)/. 
{��COLFW�Z-,#�("	N��t 
d��P?EMI�Z]�
XO3�{�
")/�9�tO:�t)/�9{)/�=(�0)�{�
")/�9�tO:�t)/�9{)/ =(�0}(,O 
ۡ�(PEMIT�Z⡋
�
�
}(��-,�9�t�9�tO:�t3�{�
)/)�{�
�9{)/
�0�9�t)/�
 
���PEMI�Z�����
@�{�,P�]ǡ 
H��PPEMI�Z{Z7k��
-,��Z��
Z7�t}(,+ 
���PPAG�Zk��
8)/P�)/
P�O�tO#�tON��t@�(Q'�
O�)/
P��%��Z��
� 
���LF�Z-,�
2�(�
-,�t��&Z��
=(�
��,O}(
)/
P��
}(��, 
A��PSPACE�ZQ'�
O�`(���%�� 
�PCRL�Z)/
P�)/
P��(�
-,�tZ��

)/<}(��&�
��M�(��O#�tON��t 
T��PC�Z{k��
��Z��
�t�}(, 
���CR�ZQ'�
O���%�� 
�PB�Z{k��
#�(�
)/P�)/��ǡZ��
�t�}(, 
���PBEL�ZZ��
G}(k��
)/P� 
3��>PRO�Z-,�(~�
�@�("	}(�(�	��(�	�
>8� 
���>PCO�Z-,#�(~�
�M�("	}(#�(�	�#�(�	�
>8;7 
���PPOSIT�Z{�&k��

>+Z7��ϤZ��
�1�t�}(,+�1, 
m��PTYP�Z{�&k��
">+Q'�
O�-,�()/=(���
�%��,Z��
�1�tf}(,+�1, 
;��PRIN�Z)/�x�t)/Bk�t)/��)/�0?)/��)/�0?)/9�)/�0?)/u�)/}0?)/�)/�0?)/ɢ)/�0?)/C�)/�0? 
ɤ�CONSOL�Z)/Ox�t)/k�t)/�)/�0?)/�)/�0?)/�)/�0?)/I)/}0?)/�)/�0?)/
)/�0?)/h)/�0? 
��(TITLE�%6��
��TITL�ZY�{Q'�
�, 
���COMPRE�Zk��
)/P� 
���SQUASH�Zk��
OP� 
_��AMBIEN�Z� Ambient Designs     Proprietary )/;7�11-14-84 
w��PAGE�%6- Q��.LINE1�Z-,lM
*7-,�{4
1�
�()/D��{�{"	4
}(, 
���.LIST1�Z�{�)/ ;7)/M
-,�
�{�{"	)/@;7)/M
�)/O��
.��p�
�.�%���, 
7��.LIST2�Z)/O��{�{"	1~?��{]��t1l�	�&�
�.�%���{)/�&
()/���t 
���LIST2U�Z���]��t�
Z7��t��Page�{)/M
)/;7e��]��t���{�
1�&�
��,�� 
���2INDE�Z1)/M
*7Z7�u)/2�Q'�
�()/F�-,)/M
*7�u)/2�� 
���PINDE�Z��1�&1"	Z7�
.
.)/7"	.1~�
,OI�
.�.�	)/7�0�

.�.�&�0=(�
��1)/7"	�&�%���1, 
B��[MOD�%6BL[REG�%6)B���[R/M�%6 c릆OBJID�%6  ��OBJSE�%6��INSTLE�%6e 맆D-FLA�%6on��W-FLA�%6 fG��#DISPB�%6S ,��[DISP�%6la:��H�Z5{Z7�-OO�*5�t 
T��2H�Z5{Z7�--,)/~�
)/0�]}(lM
5�t 
���4H�ZO)/
�7���� 
���SHR�٩YX��P����'ҩ�BIT�Z)/
=( 
b��BIT0-�Z)/=( 
���BIT0-�Z)/=( 
婄BIT�Z)/=()/
ש 
	��BIT1-�Z)/=()/
ש 
��BIT�Z)/=()/ש 
L��BIT�Z)/=()/ש 
3��BIT3-�Z)/=()/ש 
z��BIT3-�Z)/8=()/ש 
c��BIT�Z)/=()/ש 
���BIT�Z)/ =()/ש 
ê�BIT�Z)/@=()/ש 
���BIT6-�Z)/�=()/ש 
ڪ�BIT�Z)/�=()/ש 
�C@OB�Z&�{�{�1"	rS 
���@OB�Z&�{�{�1"	GS 
��$�Z-,�&�-Z75u�1+( 
!��REGNAM�%6ALCLDLBLAHCHDHBHAXCXDXBXSPBPSIDIo��.RE�ZN�{�

)/}(OZ7�
s�"	"	l� 
;��MNEMON�%6AAA   AAD   AAM   AAS   ADC   ADD   AND   CALL  CBW   CLC   CLD   CLI   CMC   CMP   CMPS  CWD   DAA   DAS   DEC   DIV   ESC   HLT   IDIV  IMUL  IN    INC   INT   INTO  IRET  JA    JAE   JB    JBE   JCXZ  JZ    JG    JGE   JL    JLE   JMP   JNZ   JNO   JNP   JNS   JO    JP    JS    LAHF  LDS   LEA   LES   LOCK  LODS  LOOP  LOOPZ LOOPNZMOV   MOVS  MUL   NEG   NOP   NOT   OR    OUT   POP   POPF  PUSH  RCL   RCR   REP   REPNE RET   ROL   ROR   SAHF  SAR   SBB   SCAS  SEG   SHL   SAL   SHR   STC   STD   STI   STOS  SUB   TEST  WAIT  XCHG  XLAT  XOR   ?     PUSHF ���.MNE�Z)/�ʫ"	)/� 
T��.ALLMN�Z)/^O�
.�	
.��%�� 
«�OPLOO�%6

B@>>>>>
>
B\

B@LLLLL
L
B@

NVVVVV
V
N[[[[[
[
N





NBBBBBBBB@@@@@@@@\\\\\\\\\\\\\\\\,)"( .+-*%$&#ccccWWYY8888818@<YYYYYYYX]AJ/888899W
W
UU44MM8	8	8	8	8	8	8	8	8	8	8	8	8	8	8	8	\\GG2088\\GGcccc
\Z765!??
'
''

?
?
3\FEcccc	RT
Scc��80-83G�%6>LV[
��D0-D3G�%6HICDOQ\K_��F6F7GR�%6W\=;:@��FEGROU�%6\\\\\\���FFGROU�%6''B\s��SPEC-M�#ri��U��U��U��U��}��}����������.MNEMO�ZO'��
G�"	�(-,)/c�&�
,O'���]'���"	�(� 
���.OBJID�Z5{�-&�{���
:�{��5�t 
k��.OBJHE�Z5{Z7�-O�
.'����%��5�t 
A��.DECOD�Z�!�4�{-,*7I�)/Z7�
�	;7�*7 
i��.�Z�
, 
���SEGRE�%6ESCSSSDS��.SEGRE�Z�
��"	l� 
���B>�ӱX�P����'߰�.IP-IN�Zѱ�{4�{"	"	r� 
ݱ�.DATA8�ZN�{�
@�}('�r� 
ͱ�.DATA�Z'�r� 
���BIT0>�ZO'��N��t 
,��BIT3>�ZO'�h�N��t 
K��.ADD�Z�
[@�r��
] 
��.IP-IN�Z�{4�{"	"	r� 
C��#[MOD�Z]'������t 
���#[REG�Z]'�����t 
���#[R/M�Z]'����t 
���##DISP�Z��{-,)/�&�
�0}(.-,l�&�
}( -,]�&�
}(�{)/�&�

\��t 
Z��#[DISP�Z\�{]�&�
l'�ѱ}(l@�i��t 
���BIT1>�ZO'�!�A��t 
Ӳ�[D][W]�ZZ�3�����ò۲/� 
'��.DIS�Zi�{r� 
j��.R/MTE�%6BX+SIBX+DIBP+SIBP+DISI   DI   BP   BX   r��.R/M0�Z�{-,)/�&�
",N�{�

�
w}(�
b�
[��}(�
[)/���"	)/�	��
] 
���.R/M01�Z�
[�{)/���"	)/�	��
+���
] 
̳�.R/M0�Z�{�� 
#��.R/MCA�#r^�ճ
-�-����.R/�Z��{p� 
h��00CLAS�Z]4��tq� 
���01CLAS�Z]4��tq�3�O����l�� 
���03CLAS�Z]4��tq�]N��tO'���� 
ʹ�04CLAS�Z]4��tq�]N��tO����O'���� 
�05CLAS�Z]4��tq�O'����� 
��06CLAS�Zl4��tq�]"� 
9��07CLAS�Zl4��tq�3�O����]"� 
S��08CLAS�Zl4��tq�]'�� 
u��09CLAS�ZJ�N�{
4��tq�O'������]� 
S��10CLAS�Z3�N�{�

)/}(l4��tq�O����]� 
���11CLAS�Z)/4��tq�3�O����]`� 
���12CLAS�Z)/4��tq�3�]`���O�� 
��13CLAS�Z)/4��tq�]@�z� 
5��14CLAS�Z)/4��tq��SP+]@��	 
S��15CLAS�Z)/4��tq��SP+]@��	�
(INTERSEG) 
w��16CLAS�Zr�l\�{"	4��tq�A�{�
�{������}(�����{�� 
���17CLAS�Zr�]N��tl\�{"	4��tq�]'��������� 
涇18CLAS�Zr�]N��tl\�{"	4��tq�����]'����� 
��19CLAS�Zr�]N��tl\�{"	4��tq��� 
F��20CLAS�Zr�l\�{"	4��tq��{������ 
l��21CLAS�Zr�]N��tl\�{"	4��tq��{������ 
���22CLAS�Zr�l\�{"	4��tq��� 
·�23CLAS�Zr�l\�{"	4��tq���A�{�
�,CL 
⷇24CLAS�ZN� 
��25CLAS�ZN� 
 ��26CLAS�Z)/4��tq�5{�-)/@����
:]@���5�t 
0��27CLAS�Zr�)/\�{"	N�{"	4��tq�����l\�{"	� 
d��28CLAS�Zr�)/\�{"	O'���]�&�
�
4��tq�����l\�{"	A�{�0N�{=(�
@�}('�A�{�
ѱr� 
���29CLAS�Zl� 
���30CLAS�Zl4��tq� 
��31CLAS�Z]4��tq�O'�꩹

�WORD}(	�BYTE 
��CLASSE�#rT:��
��״��%�C�]��	��
ŵ���
?�]������ �P�v���̷��*�:�n�����(�P��DECOD�Z��tO'��
G�"	�
�(-,)/c�&�
,]'����
�

)/}()/X�4�{��tp�
�� 
���(DCMP�%6r U��COLON-� ;Z>��(PFA�%6  ܹ�+(DCMP�Zl8��t 
���.NEXT-�Z`�*78�{{�7 
l��.NEXT-�Z`�*78�{-,{"	�7 
���.2NEXT�Z`�*78�{{�78�
{{�7`� 
���.�Z*7`�8�{�
-,�
�(�)/"�8�{�(�
8��t 
1��(.WORD�#r
T;�Ϻ(��jϺ+/v�]/���
��(���%��������X��.WOR�Z8�{-,O)/�*)/;7{
�0� 
/��DECOM�Z�-,8��t-,R��t-,�({F��&�
f�0�8�{�&p�
�
8�{{
-,)/"
�&1)/(�&�0�0�
�*75���`�}(���*75�,�8�{
�1�.�	�	�bytes}(㹍 
W��WIP�Z�
Z7�
.�u)/`(mu�%�� 
軇COMPAR�ZO�1
."	�u1
."	�u)/O�1
."	�(1
."	�(>+�&�
,+}(3��OFFSET:�.)/�/
.Or*�**7�A: Z7�	� B: �	�%��,+�%��,+ 
	��LWSCAΗ�XY�‹�_�OO&;uW�
Q���­���'Z�Rh]{l]{x]{R 
Z]{l]{�Rhx]{R 
L��OCCUR�Z�&�&>+
..���
>+�	�1"	�&-,�7
Z7,}(���1�1,+,+ 
���GI�%6!��NES�Z]%��t 
+��UNNES�Z)/��%��t%�{�
�
x1 
ʺ�.I�Z)/"	-,-,�
�(-,�
|�1Z7)/�=(��
|"	l�	 
<��.LI�Z
-,{�
=�7 
伇.BRANC�Z
-,{1"	�to �7 
���.COM�Z
-,{
�0� 
Ƚ�UCASE�#r	T;+/��(���
���%������c�jc��Ac��)н]��DELT�Z-,{
� 
���(UN�Z-,{)/Z�&�
�-,{
)/"
�&1{
)/(�&�0�0�
t�-,�7%�{;7-,{
�0�*7-,�Z7,%�{�
�
�-,)/Q�&�
,7x1}(,-,)/
�&�
,-,{
0�,�}()/P�&�
,C�
}(p�,�%�{)/"	;7�;S C�}(%�{�
�
�
�
primitive ,C� 
��UN�Z��!(sp=next, cr=nest, P=pop, Q=quit)]%��t�-
,� 
e.com S RIVES SYSGEN E.COM' "                 9-13-85 ) ;u ;128e.com                                                                                               j%6%6%6�%6�%6�
 ;%6%6%62%6�%6%6%6%6%6-%6��������(83POL%6%6��G��G��C<��'G^����%6%6���P����������	���#
scratch space):�%6��?j��G.�Z1"	Z7�.TO�
.�.VTNU�%���%�� 
%6���%6���@( ORBIT-OV - @POLY                                     9-19-84)                                                                 HEAD: @POLY ( n --, get 4 x,y vertices & save in polygon clip                      workspace array as y,x)                      T: 4 0 DO I OVER GPOLY LC@                                         2 0 DO I 2* OVER XFORMVERT L@                                          J 4 * G1POLY + I 1- NEGATE 2* + !                            LOOP DROP                                                       LOOP DROP T;                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                             ( ORBIT-OV - GVERTRANS                                 9-19-85)                                                                 HEAD: GVERTRANS ( -- \ transform all grid vertices)             T: 117 #IN !                                                      ' XFORMVERT 6 + @ 3DSEG ! 0 VOUT !                              ' G1VERT    6 + @ 3DSEG @ - 16* VIN' !                          ' GVERTEX   6 + @ 3DSEG @ - 16* VIN !                           60 YSCREEN !  36 XSCREEN !                                      VIEW>ORIGIN  ORTHAG.POINTS  PERSPEC.SCREEN T;                                                                                                                                                                                                                                                                                                                                                                                                                                                                                 ( ORBIT-OV - ?#VIS                                     9-19-85)                                                                 HEAD: ?#VIS ( n -- # , # of vertices in front of the viewing)   T:          (          plane for polygon n )                      >R                                                              0                                                               4 0 DO I J GPOLY LC@                                                   4 SWAP XFORMVERT L@                                             SCALE - 0> IF 1+ THEN                                        LOOP                                                        R> DROP T;                                                                                                                                                                                                                                                                                                                                                                                    ( ORBIT-OV - G2ORTHAG                                  9-19-85)                                                                 HEAD: G2ORTHAG                                                  T: ( compute orthagonal coordinates for polygon in g2)            4 #IN ! G2POLY VIN !  G1POLY VIN' !  G3POLY VOUT !              @DS 3DSEG ! VIEW>ORIGIN  ORTHAG.POINTS T;                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                     ( ORBIT-OV - ZCLIPSET ZXGET                            9-19-85)                                                                 HEAD: ZCLIPSET ( set clipping window for z,x & z,y clipping)    T:  16000 16000 SCALE -16000 SETCLIPWINDOW T;                                                                                   HEAD: ZXGET ( get z,x vertices for clipping)                    T:  4 0 DO I 6 * G3POLY + DUP @ SWAP 4 + @  ( X,Z --)                      I 2* 2* G1POLY + >R I ! R> 2+ !                              LOOP T;                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                 ( ORBIT-OV - ZYGET XSAVE                               9-19-85)                                                                 HEAD: ZYGET ( get z,y vertices for clipping)                    T:  4 0 DO I 6 * G3POLY + DUP 2 + @ SWAP 4 + @  ( Y,Z --)                  I 2* 2* G1POLY + >R I ! R> 2+ !                              LOOP T;                                                                                                                 HEAD: XSAVE ( save x after z,x clipping)                        T: #IN @ 0 DO VIN @ I 2* 2* + 2 + @                                           G3POLY I 6 * + !                                             LOOP T;                                                                                                                                                                                                                                                                                                                                                                              ( ORBIT-OV - YSAVE ZSAVE XY>G1POLY                    11-30-84)                                                                 HEAD: YSAVE ( save y after z,y clipping)                        T: #IN @ 0                                                        DO VIN @ I 2* 2* + 2 + @ G3POLY I 6 * + 2+ ! LOOP T;                                                                          HEAD: ZSAVE ( save z after z,y clipping)                        T: #IN @ 0                                                        DO VIN @ I 2* 2* + @ G3POLY I 6 * + 4 + ! LOOP T;                                                                             HEAD: XY>G1POLY                                                 T: #IN @ 0                                                        DO I 6 * G3POLY + DUP @ SWAP 2+ @ ( X,Y--)                      I 2* 2* G1POLY + >R I ! R> 2+ ! LOOP T;                                                                                                                                                       ( ORBIT-OV - @CLIPOLY SETPOLYCOLOR                     9-18-85)                                                                 HEAD: @CLIPOLY ( n --, 3D clip polygon n)                       T:  @XYZ>G2POLY G2ORTHAG ZCLIPSET ZXGET 4 #IN !                   G1POLY VIN ! G2POLY VOUT ! GOC OIN ! GOC2 OOUT !                CLIPPER XSAVE ZYGET 4 #IN ! G1POLY VIN ! G2POLY VOUT !          CLIPPER YSAVE ZSAVE VCLIPSET G3POLY VOUT ! PERSPEC.SCREEN       XY>G1POLY T;                                                                                                                                                                                  HEAD: SETPOLYCOLOR ( n -- \ set color & dither for polygon n)   T: 0 SWAP GRIDCOLOR OVER OVER LC@ COLOR ! 1+ LC@ DCOLOR ! T;