Algorithm 版 (精华区)
发信人: sino (茶水博士), 信区: Theory
标 题: L系统
发信站: 哈工大紫丁香 (Sun Aug 27 13:28:51 2000), 转信
发信人: beiyang (汉威), 信区: algorithm
发信站: NJU Lily BBS (Mon Mar 1 11:46:41 1999), 站内信件
Unit UnitLSystem ;
//==============================================================================
// 时间：1999-01-16
// 内容：实现L系统绘制分形图形
//==============================================================================
Interface
//==============================================================================
Uses
Classes, Graphics, Windows ;
Type
TOLSystemName = ( olKoch, olHilbert, olSierpinsky_Triangle,
olSierpinsky_Rectangle, olDragon, olBush_1, olBush_2,
olBush_3, olBush_4, olTest ) ;
//----------------------------- TRule & TRules ---------------------------------
// L系统的一个规则表示为 LeftChar ==> RuleStr ;
Type TRule = Class
LeftChar : Char ;
RuleStr : String ;
Constructor CreateAs( ALeftChar : Char ; ARuleStr : String ) ;
End ;
Type TRules = Class( TList )
Private
Function GetItems( k : Integer ) : TRule ;
Procedure SetItems( k : Integer ; Rule : TRule ) ;
Public
Property Items[k:Integer] : TRule
Read GetItems Write SetItems ; Default ;
End ;
//----------------------------- TRule & TRules ---------------------------------
//----------------------------- TOLSystem --------------------------------------
// 最简单的L系统，字符由字符串替代
// 符号 含义
//-----------------------------------
// F 前进一步
// f 前进一步不划直线
// + 顺时针转给定角度
// - 逆时针转给定角度
// | 后转180度
// [ 将龟标状态压入堆栈
// ] 从堆栈弹出龟标的状态
//-----------------------------------
Const
MaxStackSize = 255 ;
MaxDirection = 63 ;
Type
TOLSystem = Class
Private
StackSize : Integer ;
TurtleX, TurtleY : Real ;
TurtleDir, _TurtleDirCount : Integer ;
Stack_X : Array[0..MaxStackSize] Of Real ;
Stack_Y : Array[0..MaxStackSize] Of Real ;
Stack_Dir : Array[0..MaxStackSize] Of Integer ;
Coses, Sins : Array[0..MaxDirection] Of Real ;
Public
Rules : TRules ;
ResultString : String ;
Axiom : String ;
Constructor Create ;
Destructor Free ;
Procedure SetTurtleDirCount( N : Integer ) ;
Procedure GenerateString( MaxLevel : Integer ) ;
Procedure UpdateTurtleState( CommandChar : Char ) ;
Procedure SetRules( ARules : TRules ) ;
Procedure SetOLSystem( Name : TOLSystemName ) ;
Procedure DrawCurve( Canvas : TCanvas ; DrawRect : TRect ) ;
Property TurtleDirCount : Integer
Read _TurtleDirCount Write SetTurtleDirCount ;
End ;
//----------------------------- TOLSystem -----------------------------------
----
//==============================================================================
Implementation
//==============================================================================
//----------------------------- TRule & TRules ---------------------------------
Constructor TRule.CreateAs( ALeftChar : Char ; ARuleStr : String ) ;
Begin
LeftChar := ALeftChar ;
RuleStr := ARuleStr ;
End ;
Function TRules.GetItems( k : Integer ) : TRule ;
Begin
If ( k < 0 ) or ( k > Count ) Then Result := Nil
Else Result := List[k] ;
End ;
Procedure TRules.SetItems( k : Integer ; Rule : TRule ) ;
Begin
If ( k < 0 ) or ( k > Count ) Then Exit ;
List[k] := Rule ;
End ;
//----------------------------- TRule & TRules ---------------------------------
//----------------------------- TOLSystem --------------------------------------
Constructor TOLSystem.Create ;
Begin
Rules := TRules.Create ;
Axiom := '' ;
End ;
Destructor TOLSystem.Free ;
Begin
Rules.Free ;
End ;
Procedure TOLSystem.GenerateString( MaxLevel : Integer ) ;
Var
Str, RuleStr : String ;
n, k, p, StringLength : Integer ;
Found : Boolean ;
Begin
ResultString := Axiom ;
For n := 0 To MaxLevel - 1 Do
Begin
Str := '' ;
StringLength := Length( ResultString ) ;
For k := 1 To StringLength Do
Begin
Found := False ;
For p := 0 To Rules.Count - 1 Do
Begin
If ResultString[k] <> Rules[p].LeftChar Then Continue ;
Found := True ;
RuleStr := Rules[p].RuleStr ;
Break ;
End ;
If Not Found Then RuleStr := ResultString[k] ;
Str := Str + RuleStr ;
End ;
ResultString := Str ;
End ;
End ;
Procedure TOLSystem.UpdateTurtleState( CommandChar : Char ) ;
Begin
Case CommandChar Of
'F', 'f' :
Begin
TurtleX := TurtleX + Coses[TurtleDir] ;
TurtleY := TurtleY + Sins[TurtleDir] ;
End ;
'+':
Begin
TurtleDir := ( TurtleDir - 1 ) Mod TurtleDirCount ;
If TurtleDir < 0 Then Inc( TurtleDir, TurtleDirCount ) ;
End ;
'-' :
Begin
TurtleDir := ( TurtleDir + 1 ) Mod TurtleDirCount ;
If TurtleDir >= TurtleDirCount Then Dec( TurtleDir,
TurtleDirCount ) ;
End ;
'|' :
TurtleDir := ( TurtleDir + TurtleDirCount Div 2 )
Mod TurtleDirCount ;
'[' :
If StackSize < MaxStackSize Then
Begin
Stack_X[StackSize] := TurtleX ;
Stack_Y[StackSize] := TurtleY ;
Stack_Dir[StackSize] := TurtleDir ;
Inc( StackSize ) ;
End ;
']' :
If StackSize > 0 Then
Begin
Dec( StackSize ) ;
TurtleX := Stack_X[StackSize] ;
TurtleY := Stack_Y[StackSize] ;
TurtleDir := Stack_Dir[StackSize] ;
End ;
End ;
End ;
Procedure TOLSystem.SetRules( ARules : TRules ) ;
Begin
If ARules = Nil Then Exit ;
Rules.Free ;
Rules := ARules ;
End ;
Procedure TOLSystem.DrawCurve( Canvas : TCanvas ; DrawRect : TRect ) ;
Var
x,y, k, StringLength : Integer ;
Left, Right, Top, Bottom : Real ;
a, b, c, d : Real ;
Begin
StringLength := Length( ResultString ) ;
If StringLength = 0 Then Exit ;
TurtleX := 0 ;
TurtleY := 0 ;
TurtleDir := 0 ;
StackSize := 0 ;
Left := 0 ; Right := 0 ; Top := 0 ; Bottom := 0 ;
For k := 1 To StringLength Do
Begin
UpdateTurtleState( ResultString[k] ) ;
If TurtleX < Left Then Left := TurtleX ;
If TurtleX > Right Then Right := TurtleX ;
If TurtleY > Top Then Top := TurtleY ;
If TurtleY < Bottom Then Bottom := TurtleY ;
End ;
a := ( DrawRect.Right - DrawRect.Left ) / ( Right - Left ) ;
b := DrawRect.Left - a * Left ;
c := ( DrawRect.Bottom - DrawRect.Top ) / ( Bottom - Top ) ;
d := DrawRect.Top - c * Top ;
TurtleX := 0 ;
TurtleY := 0 ;
TurtleDir := 0 ;
StackSize := 0 ;
Canvas.Pen.Width := 1 ;
x := Round( b ) ; y := Round( d ) ;
Canvas.Pen.Color := RGB( 120, 80, 100 ) ;
Canvas.MoveTo( x, y ) ;
For k := 1 To StringLength Do
Begin
UpdateTurtleState( ResultString[k] ) ;
If ResultString[k] = 'F' Then
Begin
x := Round( a * TurtleX + b ) ;
y := Round( c * TurtleY + d ) ;
Canvas.LineTo( x, y ) ;
End
Else If ResultString[k] = 'f' Then
Begin
x := Round( a * TurtleX + b ) ;
y := Round( c * TurtleY + d ) ;
Canvas.MoveTo( x, y ) ;
End ;
End ;
End ;
Procedure TOLSystem.SetTurtleDirCount( N : Integer ) ;
Var
Angle, Dlt : Real ;
k : Integer ;
Begin
If N <= 1 Then Exit ;
_TurtleDirCount := N ;
Angle := 0 ;
Dlt := Pi * 2 / N ;
For k := 0 To N - 1 Do
Begin
Coses[k] := Cos( Angle ) ;
Sins[k] := Sin( Angle ) ;
Angle := Angle + Dlt ;
End ;
End ;
Procedure TOLSystem.SetOLSystem( Name : TOLSystemName ) ;
Begin
Rules.Clear ;
Case Name Of
olKoch :
Begin
Axiom := 'F' ;
TurtleDirCount := 6 ;
Rules.Add( TRule.CreateAs( 'F', 'F-F++F-F' ) ) ;
End ;
olHilbert :
Begin
Axiom := 'X' ;
TurtleDirCount := 4 ;
Rules.Add( TRule.CreateAs( 'X', '-YF+XFX+FY-' ) ) ;
Rules.Add( TRule.CreateAs( 'Y', '+XF-YFY-FX+' ) ) ;
End ;
olSierpinsky_Triangle : // There is an error in the rules.
Begin
Axiom := 'FXF--FF--FF' ;
TurtleDirCount := 6 ;
Rules.Add( TRule.CreateAs( 'X', '--FXF++FXF--' ) ) ;
Rules.add( TRule.CreateAs( 'F', 'FXF' ) ) ;
End ;
olSierpinsky_RectAngle :
Begin
Axiom := 'F+F+F+F' ;
TurtleDirCount := 4 ;
Rules.Add( TRule.CreateAs( 'F', 'FF+F+F+F+FF' ) ) ;
End ;
olBush_1 :
Begin
Axiom := 'F' ;
TurtleDirCount := 14 ;
Rules.Add( TRule.CreateAs( 'F', 'F[+F]F[-F]F' ) ) ;
End ;
olBush_2 :
Begin
Axiom := 'F' ;
TurtleDirCount := 16 ;
Rules.Add( TRule.CreateAs( 'F', 'FF+[+F-F-F]-[-F+F+F]' ) ) ;
End ;
olBush_3 :
Begin
Axiom := 'SLFFF' ;
TurtleDirCount := 20 ;
Rules.Add( TRule.CreateAs( 'S', '[+++G][---G]TS' ) ) ;
Rules.Add( TRule.CreateAs( 'G', '+H[-G]L' ) ) ;
Rules.Add( TRule.CreateAs( 'H', '-G[+H]L' ) ) ;
Rules.Add( TRule.CreateAs( 'T', 'TL' ) ) ;
Rules.Add( TRule.CreateAs( 'L', '[-FFF][+FFF]F' ) ) ;
End ;
olBush_4 :
Begin
Axiom := 'G' ;
TurtleDirCount := 14 ;
Rules.Add( TRule.CreateAs( 'G', 'GFX[+G][-G]' ) ) ;
Rules.Add( TRule.CreateAs( 'X', 'X[-FFF][+FFF]FX' ) ) ;
End ;
olTest :
Begin
Axiom := '-F' ;
TurtleDirCount := 6 ;
Rules.Add( TRule.CreateAs( 'F', '-F+FF+F' ) ) ;
End ;
olDragon :
Begin
TurtleDirCount := 4 ;
Axiom := 'X' ;
Rules.Add( TRule.CreateAs( 'X', 'X+YF+' ) ) ;
Rules.Add( TRule.CreateAs( 'Y', '-FX-Y' ) ) ;
End ;
End ;
End ;
//----------------------------- TOLSystem --------------------------------------
//==============================================================================
End .
--
※ 修改:．fib 於 Aug 27 13:26:22 修改本文．[FROM: bbs.hit.edu.cn]
--
※ 转寄:．南京大学小百合 bbs.nju.edu.cn．[FROM: bbs.hit.edu.cn]
--
☆ 来源:．哈工大紫丁香 bbs.hit.edu.cn．[FROM: fib.bbs@bbs.nju.edu.]
Powered by KBS BBS 2.0 (http://dev.kcn.cn)
页面执行时间：213.500毫秒