REFSKRIPT
; überarbeitet von Carsten Lotz, 23.8.1997
>masse1:
GET_XYZ Kegelstumpf Breite(unten) Breite(oben) Höhe
RETURN_IF_ABBRUCH 0
GET_RESULT res
COPY_WORD res 1
GET_RESULT breite_unten
COPY_WORD res 2
GET_RESULT breite_oben
COPY_WORD res 3
GET_RESULT hoehe
IF_NOT_EQUAL_GOTO hoehe 0 masse2
  MELDUNG Höhe Null nicht möglich.
  GOTO masse1
>masse2:
GET_INT Segmentzahl?
RETURN_IF_ABBRUCH 0
GET_RESULT nseq
IF_NOT_EQUAL_GOTO nseq 0 rechnen
  MELDUNG Mindestens zwei Seqmente.
  GOTO masse2

>rechnen:
DIV hoehe 2
GET_RESULT h2
MUL h2 -1
GET_RESULT h2_min
DIV breite_unten 2
GET_RESULT rad_unten
DIV breite_oben 2
GET_RESULT rad_oben

; Dreiecks-Objekt erzeugen */
OBJ_new Kegelstumpf 3
GET_RESULT k
GEO_NEW_PT k
GET_RESULT i0
GEO_NEW_PT k
GET_RESULT i1
GEO_SET_PT k i0 0 0 h2_min
GEO_SET_PT k i1 0 0 h2
SET_VAR i 1
SET_VAR winkel 0
SUB nseq 1
GET_RESULT ns1
DIV 360 nseq
GET_RESULT dw
>do_loop1:
   SIN winkel
   GET_RESULT si
   COS winkel
   GET_RESULT co
   MUL si rad_unten
   GET_RESULT y
   MUL co rad_unten
   GET_RESULT x

   GEO_NEW_PT k
   GET_RESULT j
   GEO_SET_PT k j x y h2_min
   ADD winkel dw
   GET_RESULT winkel
   ADD i 1
   GET_RESULT i
   IF_GREATER_GOTO i nseq fert1
   GOTO do_loop1
>fert1:
SET_VAR i 1
SET_VAR winkel 0
DIV 360 nseq
GET_RESULT dw
>do_loop2:
   SIN winkel
   GET_RESULT si
   COS winkel
   GET_RESULT co
   MUL si rad_oben
   GET_RESULT y
   MUL co rad_oben
   GET_RESULT x

   GEO_NEW_PT k
   GET_RESULT j
   GEO_SET_PT k j x y h2
   ADD winkel dw
   GET_RESULT winkel
   ADD i 1
   GET_RESULT i
   IF_GREATER_GOTO i nseq fert2
   GOTO do_loop2
>fert2:
; Jetzt die dreiecke erzeugen 
ADD i1 1
GET_RESULT i2
ADD i2 nseq
GET_RESULT i3
SET_VAR i 0
>do_loop3:
; boden_dreieck
   ADD i 1
   GET_RESULT ip1
   MOD ip1 nseq
   GET_RESULT ip1
   ADD i2 i
   GET_RESULT p
   ADD i2 ip1
   GET_RESULT q
   
   DREI_NEW_DREI k i0 q p
; jetzt zwischen_dreiecke
   ADD i3 i
   GET_RESULT p1
   ADD i3 ip1
   GET_RESULT q1
   
   DREI_NEW_DREI k p q q1 1
   DREI_NEW_DREI k p q1 p1 1
; decken_dreieck
   DREI_NEW_DREI k i1 p1 q1
   
   ADD i 1
   GET_RESULT i
   IF_GREATER_GOTO i nseq fert3
   IF_EQUAL_GOTO i nseq fert3
   GOTO do_loop3
>fert3:
PKL_ADD k
ZENTRIEREN k
PLOT_PKL

RETURN 1