XProfan

Class TPoint = x& , y&

proc TPoint.TPoint

    parameters ppx& , ppy&
    .x& = ppx&
    .y& = ppy&

endproc

declare Point# , Stack#
neuen Punkt in die Liste eintragen

proc NewPoint

    parameters px& , py&
    Hier wird der Punkt als Klasse ganz gewohnt erzeugt.
    Point# = New(TPoint,px&,py&)
    Hier ist der Trick: Damit der Punkt nicht verloren geht, wird seine
    Adresse in einer internen Liste (Stack#) gespeichert. Die Liste ist
    dynamisch, daher können theoretisch unendlich viele Punkte erzeugt werden.
    Dim Stack# , SizeOf(Stack#) + 4
    Long Stack# , (SizeOf(Stack#) - 4) = Point#

endproc

Bei allen folgenden Prozeduren wird zuerst die Adresse des gewünschten
Punktes auf das als Lesekopf dienende Objekt übertragen. Aus ihm können
dann alle gewünschten Informationen ausgelesen werden.

proc SetPointX

    parameters nr% , px&
    Point# = Long(Stack#,nr% * 4)
    Point#.x& = px&

endproc

proc SetPointY

    parameters nr% , py&
    Point# = Long(Stack#,nr% * 4)
    Point#.y& = py&

endproc

proc GetPointX

    parameters nr%
    Point# = Long(Stack#,nr% * 4)
    return Point#.x&

endproc

proc GetPointY

    parameters nr%
    Point# = Long(Stack#,nr% * 4)
    return Point#.y&

endproc

proc Draw

    parameters nr%
    Point# = Long(Stack#,nr% * 4)
    SetPixel Point#.x& , Point#.y& , 0

endproc

Auch hier nimmt das Lesekopfobjekt die Adresse des gewünschten Punktes an.
Dieser wird dispost und dann aus der Liste entfernt. Das Lesekopfobjekt wird
anschließend weiter verwendet.

proc DelPoint

    parameters nr%
    Point# = Long(Stack#,nr% * 4)
    Dispose Point#
    Char Stack# , (nr% * 4) = Char$(Stack#,(nr% * 4) + 4,SizeOf(Stack#) - (nr% * 4) - 4)
    Dim Stack# , SizeOf(Stack#) - 4

endproc

Hier werden der Reihe nach alle Punkte dispost und danach auch die Liste selbst.

proc ClearStack

    whileloop 0 , SizeOf(Stack#) , 4

        Point# = Long(Stack#,&loop)
        Dispose Point#

    EndWhile

    Dispose Stack#

endproc

Hauptprogramm
cls

whileloop 20,40

    NewPoint &loop,20

EndWhile

whileloop 0,20

    Draw &loop

EndWhile

ClearStack
waitinput
end