[F#] 간단한 Graphics 모듈을 만들어 봤습니다.
F#에서 표준 모듈은 같은 규격이 없는 것 같아 SVG 출력을 기반으로 제작하기로 했다.
실시 방침
원래는 2차원의 선, 직사각형, 원, 다각형 등을 단순하게 직관적으로 그려내려고 했다.
지금 습득한 지식이라면 SVG를 활용하는 것이 가장 간단하다고 생각해 SVG를 생성하는 코드를 쓰기로 했다.
인터페이스는 기본적으로 OCAml의 그래픽스 모듈을 기반으로 복제를 만드는 것이 아니라 적절하게 접고 정리했다.
소스 코드
실현은 다음과 같다.
) 형식이므로 이벤트 클래스 처리는 JavaScript를 모두 기록합니다.
module Graphics
type EntityAttribute =
| Id of string
| Class of string list
| Title of string
type Command =
| Plot of float * float * EntityAttribute list
| Plots of (float * float) array * EntityAttribute list
| MoveTo of float * float
| RMoveTo of float * float
| LineTo of float * float * EntityAttribute list
| RLineTo of float * float * EntityAttribute list
| DrawRect of float * float * float * float * EntityAttribute list
| DrawPolyLine of (float * float) array * EntityAttribute list
| DrawPoly of (float * float) array * EntityAttribute list
| FillPoly of (float * float) array * EntityAttribute list
| DrawCircle of float * float * float * EntityAttribute list
| FillRect of float * float * float * float * EntityAttribute list
| FillCircle of float * float * float * EntityAttribute list
| DrawString of string * EntityAttribute list
| SetLineWidth of int
| SetTextSize of int
| SetColor of int * int * int
with
member this.WithId (id : string) =
match this with
| Plot (x, y, attrs) -> Plot (x, y, Id(id) :: attrs)
| Plots (points, attrs) -> Plots (points, Id(id) :: attrs)
| LineTo (x, y, attrs) -> LineTo (x, y, Id(id) :: attrs)
| RLineTo (dx, dy, attrs) -> RLineTo (dx, dy, Id(id) :: attrs)
| DrawRect (x, y, w, h, attrs) -> DrawRect (x, y, w, h, Id(id) :: attrs)
| DrawPolyLine (points, attrs) -> DrawPolyLine (points, Id(id) :: attrs)
| DrawPoly (points, attrs) -> DrawPoly (points, Id(id) :: attrs)
| FillPoly (points, attrs) -> FillPoly (points, Id(id) :: attrs)
| DrawCircle (cx, cy, r, attrs) -> DrawCircle (cx, cy, r, Id(id) :: attrs)
| FillRect (x, y, w, h, attrs) -> FillRect (x, y, w, h, Id(id) :: attrs)
| FillCircle (cx, cy, r, attrs) -> FillCircle (cx, cy, r, Id(id) :: attrs)
| DrawString (s, attrs) -> DrawString (s, Id(id) :: attrs)
| _ as org -> org
member this.WithClass (className : string) =
match this with
| Plot (x, y, attrs) -> Plot (x, y, Class([className]) :: attrs)
| Plots (points, attrs) -> Plots (points, Class([className]) :: attrs)
| LineTo (x, y, attrs) -> LineTo (x, y, Class([className]) :: attrs)
| RLineTo (dx, dy, attrs) -> RLineTo (dx, dy, Class([className]) :: attrs)
| DrawRect (x, y, w, h, attrs) -> DrawRect (x, y, w, h, Class([className]) :: attrs)
| DrawPolyLine (points, attrs) -> DrawPolyLine (points, Class([className]) :: attrs)
| DrawPoly (points, attrs) -> DrawPoly (points, Class([className]) :: attrs)
| FillPoly (points, attrs) -> FillPoly (points, Class([className]) :: attrs)
| DrawCircle (cx, cy, r, attrs) -> DrawCircle (cx, cy, r, Class([className]) :: attrs)
| FillRect (x, y, w, h, attrs) -> FillRect (x, y, w, h, Class([className]) :: attrs)
| FillCircle (cx, cy, r, attrs) -> FillCircle (cx, cy, r, Class([className]) :: attrs)
| DrawString (s, attrs) -> DrawString (s, Class([className]) :: attrs)
| _ as org -> org
member this.WithTitle (title : string) =
match this with
| Plot (x, y, attrs) -> Plot (x, y, Title(title) :: attrs)
| Plots (points, attrs) -> Plots (points, Title(title) :: attrs)
| LineTo (x, y, attrs) -> LineTo (x, y, Title(title) :: attrs)
| RLineTo (dx, dy, attrs) -> RLineTo (dx, dy, Title(title) :: attrs)
| DrawRect (x, y, w, h, attrs) -> DrawRect (x, y, w, h, Title(title) :: attrs)
| DrawPolyLine (points, attrs) -> DrawPolyLine (points, Title(title) :: attrs)
| DrawPoly (points, attrs) -> DrawPoly (points, Title(title) :: attrs)
| FillPoly (points, attrs) -> FillPoly (points, Title(title) :: attrs)
| DrawCircle (cx, cy, r, attrs) -> DrawCircle (cx, cy, r, Title(title) :: attrs)
| FillRect (x, y, w, h, attrs) -> FillRect (x, y, w, h, Title(title) :: attrs)
| FillCircle (cx, cy, r, attrs) -> FillCircle (cx, cy, r, Title(title) :: attrs)
| DrawString (s, attrs) -> DrawString (s, Title(title) :: attrs)
| _ as org -> org
type GraphicsEvent =
{
Selector : string
EventName : string
Callback : string
}
let mutable m_mouseoverStyle : (string * string) list =
[
("stroke-width", "5")
("stroke", "blue")
("fill", "blue")
("fill-opacity", "0.5")
]
let mutable m_currentX = 0.0
let mutable m_currentY = 0.0
let mutable m_lineWidth = 1
let mutable m_textSize = 8
let mutable m_color = (0, 0, 0)
let mutable m_commandBuffer : Command list = []
let mutable m_events : GraphicsEvent list = []
let private attrText = function
| Id (s) -> sprintf " id='%s' " s
| Class (classes) -> System.String.Join (" ", classes)
|> sprintf " class='%s' "
| _ -> ""
let private titleText (attrs : EntityAttribute list) =
attrs
|> List.tryFind (fun x -> match x with | Title _ -> true | _ -> false)
|> function
| Some (Title (title)) -> sprintf "<title>%s</title>" title
| _ -> ""
let attrTextLine (attrs : EntityAttribute list) =
let mergeClass (target : EntityAttribute list) =
let classes =
target
|> List.choose (fun x -> match x with | Class classes -> Some (classes) | _ -> None)
|> List.concat
let others =
target
|> List.filter (fun x -> match x with | Class _ -> false | _ -> true)
List.concat [ others; [ Class (classes) ] ]
attrs
|> mergeClass
|> List.map attrText
|> fun x -> System.String.Join ("", x)
let setMouseoverStyle (kvPairs : (string * string) list) =
m_mouseoverStyle <- kvPairs
let svgPoint (attrs : EntityAttribute list) =
let (r, g, b) = m_color
sprintf "<circle %s cx='%.1f' cy='%.1f' r='2' fill='rgb(%d,%d,%d)'>%s</circle>"
(attrTextLine attrs)
m_currentX m_currentY r g b
(titleText attrs)
let svgLine (toX : float, toY : float) (attrs : EntityAttribute list) =
let (r, g, b) = m_color
sprintf "<line %s x1='%.1f' y1='%.1f' x2='%.1f' y2='%.1f' stroke='rgb(%d,%d,%d)' stroke-width='%d'>%s</line>"
(attrTextLine attrs)
m_currentX m_currentY toX toY r g b m_lineWidth
(titleText attrs)
let svgDrawRect (x : float, y : float, w : float, h : float) (attrs : EntityAttribute list) =
let (r, g, b) = m_color
sprintf "<rect %s x='%.1f' y='%.1f' width='%.1f' height='%.1f' stroke='rgb(%d,%d,%d)' fill='transparent' stroke-width='%d'>%s</rect>"
(attrTextLine attrs)
x y w h r g b
m_lineWidth
(titleText attrs)
let svgDrawCircle (cx : float, cy : float, radius : float) (attrs : EntityAttribute list) =
let (r, g, b) = m_color
sprintf "<circle %s cx='%.1f' cy='%.1f' r='%.1f' stroke='rgb(%d,%d,%d)' fill='transparent' stroke-width='%d'>%s</circle>"
(attrTextLine attrs)
cx cy radius r g b
m_lineWidth
(titleText attrs)
let svgFillRect (x : float, y : float, w : float, h : float) (attrs : EntityAttribute list) =
let (r, g, b) = m_color
sprintf "<rect %s x='%.1f' y='%.1f' width='%.1f' height='%.1f' fill='rgb(%d,%d,%d)' stroke-width='%d'>%s</rect>"
(attrTextLine attrs)
x y w h r g b
m_lineWidth
(titleText attrs)
let svgFillCircle (cx : float, cy : float, radius : float) (attrs : EntityAttribute list) =
let (r, g, b) = m_color
sprintf "<circle %s cx='%.1f' cy='%.1f' r='%.1f' fill='rgb(%d,%d,%d)' stroke-width='%d'>%s</circle>"
(attrTextLine attrs)
cx cy radius r g b
m_lineWidth
(titleText attrs)
let svgDrawPolygon (points : (float * float) array) (attrs : EntityAttribute list) =
let (r, g, b) = m_color
sprintf "<polygon %s points='%s' stroke='rgb(%d,%d,%d)' fill='transparent' stroke-width='%d'>%s</polygon>"
(attrTextLine attrs)
(points |> Array.map (fun (x, y) -> sprintf "%.1f,%.1f" x y)
|> fun vs -> System.String.Join (" ", vs))
r g b
m_lineWidth
(titleText attrs)
let svgDrawPolyLine (points : (float * float) array) (attrs : EntityAttribute list) =
let (r, g, b) = m_color
sprintf "<polyline %s points='%s' stroke='rgb(%d,%d,%d)' stroke-width='%d'>%s</polyline>"
(attrTextLine attrs)
(points |> Array.map (fun (x, y) -> sprintf "%.1f,%.1f" x y)
|> fun vs -> System.String.Join (" ", vs))
r g b
m_lineWidth
(titleText attrs)
let svgFillPolygon (points : (float * float) array) (attrs : EntityAttribute list) =
let (r, g, b) = m_color
sprintf "<polygon %s points='%s' fill='rgb(%d,%d,%d)' stroke-width='%d'>%s</polygon>"
(attrTextLine attrs)
(points |> Array.map (fun (x, y) -> sprintf "%.1f,%.1f" x y)
|> fun vs -> System.String.Join (" ", vs))
r g b
m_lineWidth
(titleText attrs)
let svgText (s : string) (attrs : EntityAttribute list) =
let (r, g, b) = m_color
sprintf "<text %s font-size='%d' stroke='rgb(%d,%d,%d)' fill='rgb(%d,%d,%d)' >%s</text>"
(attrTextLine attrs)
m_textSize
r g b
r g b
s
let doCommand = function
| Plot (x, y, attrs) -> let s = svgPoint attrs
m_currentX <- x
m_currentY <- y
s
| Plots (points, attrs) -> points |> Array.map (fun (x, y) ->
m_currentX <- x
m_currentY <- y
svgPoint attrs
)
|> fun x -> System.String.Join ("\n", x)
| MoveTo (x, y) -> m_currentX <- x
m_currentY <- y
""
| RMoveTo (dx, dy) -> m_currentX <- m_currentX + dx
m_currentY <- m_currentY + dy
""
| LineTo (x, y, attrs) -> let s = svgLine (x, y) attrs
m_currentX <- x
m_currentY <- y
s
| RLineTo (dx, dy, attrs) -> let (x, y) = (m_currentX + dx, m_currentY + dy)
let s = svgLine (x, y) attrs
m_currentX <- x
m_currentY <- y
s
| DrawRect (x, y, w, h, attrs) -> svgDrawRect (x, y, w, h) attrs
| DrawPolyLine (points, attrs) -> svgDrawPolyLine (points) attrs
| DrawPoly (points, attrs) -> svgDrawPolygon (points) attrs
| FillPoly (points, attrs) -> svgFillPolygon (points) attrs
| DrawCircle (cx, cy, r, attrs) -> svgDrawCircle (cx, cy, r) attrs
| FillRect (x, y, w, h, attrs) -> svgFillRect (x, y, w, h) attrs
| FillCircle (cx, cy, r, attrs) -> svgFillCircle (cx, cy, r) attrs
| DrawString (s, attrs) -> svgText (s) attrs
| SetLineWidth (width) -> m_lineWidth <- width
""
| SetTextSize (size) -> m_textSize <- size
""
| SetColor (r, g, b) -> m_color <- (r, g, b)
""
let private generateScript (event : GraphicsEvent) =
let selector = event.Selector
let eventName = event.EventName
let callback = event.Callback
[|
sprintf "document.querySelectorAll('%s').forEach(element => {" selector;
sprintf " element.addEventListener('%s', eve => {" eventName;
sprintf " %s" (callback.Replace("\n", "\n "));
" });";
"});"
|]
|> fun x -> System.String.Join("\n", x)
let private generateStyles () =
m_mouseoverStyle
|> List.map (fun (key, value) -> sprintf "%s : %s;" key value)
|> fun x -> System.String.Join (" ", x)
|> sprintf ".mouseover { %s }"
let private generateHtml (w, h) =
let scripts =
m_events
|> List.rev
|> List.map generateScript
|> fun x -> System.String.Join ("\n\n", x)
let svgContent =
m_commandBuffer
|> List.rev
|> List.map doCommand
|> fun x -> System.String.Join("\n", x)
sprintf """
<html>
<style>
%s
</style>
<body>
<svg width='%dpx' height='%dpx' viewbox='0,0,%d,%d' >
%s
</svg>
<script>
%s
</script>
</body>
</html>
"""
(generateStyles ())
w
h
w
h
svgContent
scripts
let saveHtml (w, h) =
let dst = @".\canvas.html"
generateHtml (w, h)
|> fun content -> System.IO.File.WriteAllText(dst, content)
dst
let openGraph(w, h) =
let dst = saveHtml (w, h)
System.Diagnostics.Process.Start(dst)
let closeGraph() = ()
let clearGraph() = ()
let sizeX() = ()
let sizeY() = ()
let private addBuffer (command) =
m_commandBuffer <- command :: m_commandBuffer
let defaultEntityAttributes =
[ Class (["entity"]) ]
let plot (x : float) (y : float) =
addBuffer <| Plot(x, y, defaultEntityAttributes)
let plots (pairs : (float * float) array) =
addBuffer <| Plots (pairs, defaultEntityAttributes)
let moveTo (x : float) (y : float) =
addBuffer <| MoveTo(x, y)
let rmoveTo (dx : float) (dy : float) =
addBuffer <| RMoveTo(dx, dy)
let currentX () = m_currentX
let currentY () = m_currentY
let lineTo (x : float) (y : float) =
addBuffer <| LineTo (x, y, defaultEntityAttributes)
let rlineTo (dx : float) (dy : float) =
addBuffer <| RLineTo (dx, dy, defaultEntityAttributes)
let drawRect (x : float) (y : float) (w : float) (h : float) =
addBuffer <| DrawRect (x, y, w, h, defaultEntityAttributes)
let drawPolyLine (pairs : (float * float) array) =
addBuffer <| DrawPolyLine (pairs, defaultEntityAttributes)
let drawPoly (pairs : (float * float) array) =
addBuffer <| DrawPoly (pairs, defaultEntityAttributes)
let fillPoly (pairs : (float * float) array) =
addBuffer <| FillPoly (pairs, defaultEntityAttributes)
let drawCircle (x : float) (y : float) (r : float) =
addBuffer <| DrawCircle (x, y, r, defaultEntityAttributes)
let setLineWidth (width : int) =
addBuffer <| SetLineWidth (width)
let setColor (r, g, b) =
addBuffer <| SetColor (r, g, b)
let drawString (s : string) =
addBuffer <| DrawString (s, defaultEntityAttributes)
let setTextSize (size : int) =
addBuffer <| SetTextSize (size)
let fillRect (x : float) (y : float) (w : float) (h : float) =
addBuffer <| FillRect (x, y, w, h, defaultEntityAttributes)
let fillCircle (x : float) (y : float) (r : float) =
addBuffer <| FillCircle (x, y, r, defaultEntityAttributes)
let withId (id : string) =
match m_commandBuffer with
| [] -> ()
| hd :: tl -> m_commandBuffer <- hd.WithId(id) :: tl
let withClass (className : string) =
match m_commandBuffer with
| [] -> ()
| hd :: tl -> m_commandBuffer <- hd.WithClass(className) :: tl
let withTitle (title : string) =
match m_commandBuffer with
| [] -> ()
| hd :: tl -> m_commandBuffer <- hd.WithTitle(title) :: tl
let addEventListener (selector : string) (eventName : string) (callback : string) =
m_events <- { Selector = selector
EventName = eventName
Callback = callback }
:: m_events
let addDefaultEventListener () =
addEventListener ".entity" "mouseover" "element.classList.add('mouseover');"
addEventListener ".entity" "mouseleave" "element.classList.remove('mouseover');"
사용법
이런 느낌의 대본을 쓰다.
#load "Graphics.fs"
open Graphics
let test () =
let gridPoints =
[| for i in 0 .. 2 ->
[|
for j in 0 .. 2 -> (float ((i + 1) * 100), float ((j + 1) * 100))
|]
|]
|> Array.concat
let gridLines =
[|
(gridPoints.[0], gridPoints.[1])
(gridPoints.[1], gridPoints.[2])
(gridPoints.[3], gridPoints.[4])
(gridPoints.[4], gridPoints.[5])
(gridPoints.[6], gridPoints.[7])
(gridPoints.[7], gridPoints.[8])
(gridPoints.[0], gridPoints.[3])
(gridPoints.[1], gridPoints.[4])
(gridPoints.[2], gridPoints.[5])
(gridPoints.[3], gridPoints.[6])
(gridPoints.[4], gridPoints.[7])
(gridPoints.[5], gridPoints.[8])
|]
setColor (200, 200, 200)
fillPoly [| gridPoints.[0]; gridPoints.[1]; gridPoints.[4]; gridPoints.[3] |]
withTitle "rect1"
fillPoly [| gridPoints.[1]; gridPoints.[2]; gridPoints.[5]; gridPoints.[4] |]
withTitle "rect2"
setLineWidth 5
setColor (100, 100, 100)
gridLines
|> Array.iteri (fun i ((x1, y1), (x2, y2)) ->
moveTo x1 y1
lineTo x2 y2
withTitle <| sprintf "line%d" (i + 1)
)
gridPoints
|> Array.iteri (fun i (x, y) ->
fillCircle x y 10.0
withTitle <| sprintf "point%d" (i + 1)
)
addDefaultEventListener()
saveHtml (600, 600)
let path = test()
printfn "%s" path
총결산
Reference
이 문제에 관하여([F#] 간단한 Graphics 모듈을 만들어 봤습니다.), 우리는 이곳에서 더 많은 자료를 발견하고 링크를 클릭하여 보았다 https://zenn.dev/sos/articles/f1fd992be15091텍스트를 자유롭게 공유하거나 복사할 수 있습니다.하지만 이 문서의 URL은 참조 URL로 남겨 두십시오.
우수한 개발자 콘텐츠 발견에 전념
(Collection and Share based on the CC Protocol.)
좋은 웹페이지 즐겨찾기
