REFSKRIPT
GET_XY Breite_des_Kegels Unten Oben
RETURN_IF_ABBRUCH 0
GET_RESULT res
COPY_WORD res 1
GET_RESULT breite_unten
COPY_WORD res 2
GET_RESULT breite_oben
GET_REAL Höhe des Kegels
RETURN_IF_ABBRUCH 0
GET_RESULT hoehe
GET_INT #Seqmente 
RETURN_IF_ABBRUCH 0
GET_RESULT nseq

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 kegel_stumpf 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
