Rodhos Soft

備忘録を兼ねた技術的なメモです。Rofhos SoftではiOSアプリ開発を中心としてAndroid, Webサービス等の開発を承っております。まずはご相談下さい。

お絵かき

haskellでお絵かきをするhtmlのコードを無理やり吐き出させてみた。もっとスマートにやれるはず。。

import Data.List
main = print tag_doctype


tag_doctype = "<!DOCTYPE html>" ++ html
html = tag_html (tag_header (tag_title "OK!") ++ tag_body (tag_p "hello")  ++ tag_div (tag_canvas "") ++ tag_script scriptlist)

tag_html txt = "<html>" ++ txt ++ "</html>"
tag_header txt = "<head>" ++ txt ++ "</head>"
tag_body txt = "<body>" ++ txt ++ "</body>"
tag_title txt = "<title>" ++ txt ++ "</title>"

tag_div txt = "<div>" ++ txt ++ "</div>"
tag_canvas txt = "<canvas id='canvas' width='200' height='200'>" ++ txt ++ "</canvas>"
tag_p txt = "<p>" ++ txt ++ "</p>"
tag_script txt = "<script>" ++ txt ++ "</script>"

assign v e = v ++ " = " ++ e
variable v = "var " ++ v
action target message = " " ++ target ++ "." ++ message
func name v = name ++ "(" ++ v ++")"
quo el = "'" ++ el ++  "'"
getElement el= action "document" (func "getElementById" (quo el))
jsfunc funcname input block = "function " ++ funcname ++ "(" ++ input  ++ ")" ++ block

canvas = "canvas"
context = "context"
sc1 = assign (variable canvas) (getElement canvas)
sc2 = assign (variable context)  (action canvas (func "getContext" (quo "2d")))
sc3 = assign (variable "cx") "100"
sc4 = assign (variable "cy") "100"

sc5 = action context (func "beginPath" "")
sc6 = assign "context.strokeStyle" "'#ff0000'"
sc7 = action context (func "arc" "120, 80, 70, 0, Math.PI*2, false")
sc8 = action context (func "stroke" "")

--jsfunc "drawFillRect" "cx,cy,w,h" (action context (func "fillRect" "cx-w/2, cy-h/2, w, h"))

-- sc9 = "drawFillRect(10,10,40,40)"

scriptlist = intercalate ";" [sc1,sc2,sc3,sc4,sc5,sc6,sc7,sc8]