MokkosuでHypotrochoidを作ってみた

はじめに

SKPSKSさんの記事を読んで、私も関数型言語 Mokkosu で Hypotrochoid を作ってみました。

ソースコード

Hypotrochoid.mok

#=============================================================================
#! @file    Hypotrochoid.mok
#! @brief   Yet Another Hypotrochoid
#! @author  kielnow
#=============================================================================
#__define "CONSOLE_APPLICATION";

include "Print.mok";
include "List.mok";
include "Graphics.mok";

using System;
using System.Collections;

#-----------------------------------------------------------------------------
# AFX
#-----------------------------------------------------------------------------
fun map f = {
  [] -> [];
  x::xs -> f x :: map f xs;
};
fun concat = {
  [] -> [];
  x::xs -> x ++ concat xs;
};
let concat_map f lis = concat (map f lis);
let __for_bind lis f = concat_map f lis;

let double_to_float (d : Double) = call Convert::ToSingle(d);
let float_to_double (f : {Single}) = call Convert::ToDouble(f);

#-----------------------------------------------------------------------------
# Global constants
#-----------------------------------------------------------------------------
let (screen_width,screen_height) = (800,600);
let fps = 120;
let fps_inv = 1000 / fps;
let title = "Hypotrochoid";

let (origin_x, origin_y) as origin = (screen_width/2,screen_height/2);
let points_max = 8192;

#-----------------------------------------------------------------------------
# Global states
#-----------------------------------------------------------------------------
# outer circle
let radius_o = ref 200.0;
let centre_o = ref (int_to_double origin_x, int_to_double origin_y);

# inner circle
let radius_i = ref 127.0;
let centre_i =
  let ri = !radius_i in
  let ro = !radius_o in
  let (xo,yo) = !centre_o in
  ref (xo +.ro-.ri, yo);

# distance from the centre of the inner circle
let dist = ref 226.0;
let delta_dist = ref 16.0;

# angle
let theta = ref 0.0;
let delta_theta = ref (!delta_dist *. !radius_i /. (!dist *. !radius_o));

let points = newarr<PointF>(points_max);
let points_begin = ref 0;
let points_end = ref 1;

let points_loop = newarr<PointF>(5);

let point = ref (0.0,0.0);

let pause = ref false;
let show_circle = ref true;

#-----------------------------------------------------------------------------
# Utilities
#-----------------------------------------------------------------------------
let get_state () = 
  let ro = !radius_o in
  let ri = !radius_i in
  let d  = !dist in
  let (xo,yo) as co = !centre_o in
  let (xi,yi) as ci = !centre_i in
  ((ro,ri,d),co,ci);

let reset_delta_theta () =
  let d = ((!delta_dist *. !radius_i) /. (!dist *. !radius_o)) in
  do
    delta_theta := min 0.1 (max 0.00001 d);
  end;

let to_PointF (x,y) = new PointF(double_to_float x, double_to_float y);
let from_PointF (p : {PointF}) = (float_to_double p.get_X(), float_to_double p.get_Y());

#-----------------------------------------------------------------------------
# GraphicsEx
#-----------------------------------------------------------------------------
let mokkosu_brush = new_solid_brush 103 128 170;
let mokkosu_pen = new_pen 103 128 170 1;
let mokkosu_pen2 = new_pen 103 128 170 2;

let gradient_brush =
  let c1 = call Color::get_Cyan() in
  let c2 = call Color::get_Blue() in
  let p1 = new Point(0,0) in
  let p2 = new Point(screen_width,screen_height) in
  new Drawing2D.LinearGradientBrush(p1,p2,c1,c2);
let gradient_pen = new Pen(gradient_brush,1);
let gradient_pen2 = new Pen(gradient_brush,2);

let gx_clear gr brush = fill_rectangle gr brush 0 0 screen_width screen_height;

let gx_draw_circle gr pen (x,y) r =
  let (x_,y_) = (double_to_int x, double_to_int y) in
  let r_ = double_to_int r in
  let d = 2*r_ in draw_ellipse gr pen (x_-r_) (y_-r_) d d;

let gx_draw_line gr pen (x1,y1) (x2,y2) = 
  let (x1_,y1_) = (double_to_int x1, double_to_int y1) in
  let (x2_,y2_) = (double_to_int x2, double_to_int y2) in
  draw_line gr pen x1_ y1_ x2_ y2_;

let gx_draw_curve (gr : {Graphics}) (pen : {Pen}) (ps : {PointF[]}) = gr.DrawCurve(pen, ps);
let gx_draw_curve_ofs (gr : {Graphics}) (pen : {Pen}) (ps : {PointF[]}) (ofs : Int) (num : Int) = gr.DrawCurve(pen, ps, ofs, num);

#-----------------------------------------------------------------------------
# Hypotrochoid
#-----------------------------------------------------------------------------
let hypotrochoid (ox,oy) (ro,ri,d) t =
  let a = ro -. ri in
  let b = a /. ri in
  let x = a *. cos t +. d *. cos (b *. t) in
  let y = a *. sin t -. d *. sin (b *. t) in
  (ox+.x,oy+.y);

#-----------------------------------------------------------------------------
# Scene init
#-----------------------------------------------------------------------------
let tick_init () =
  let (((ro,ri,d) as ht), ((xo,yo) as co), ((xi,yi) as ci)) = get_state () in
  let p = hypotrochoid co ht !theta in
  do
    reset_delta_theta ();
    theta := 0.0;
    points_begin := 1;
    points_end   := 2;
    stelem<PointF>(points, 0, to_PointF p);
    stelem<PointF>(points, 1, to_PointF p);
    stelem<PointF>(points, 2, to_PointF p);
    point := p;
    pause := false;
    show_circle := true;
    switch "main";
  end;    

#-----------------------------------------------------------------------------
# Scene main
#-----------------------------------------------------------------------------
let tick_main () = if !pause -> redraw () else
  let (((ro,ri,d) as ht), co, _) = get_state () in
  let new_theta = !theta +. !delta_theta in
  let (b,e) = (!points_begin, !points_end) in
  let e1 = (e + 1) % points_max in
  let e2 = (e + 2) % points_max in
  let p = hypotrochoid co ht new_theta in
  do
    theta := new_theta;
    stelem<PointF>(points, e, to_PointF p);
    stelem<PointF>(points, e1, to_PointF p);
    points_end := e1;
    if e2 == b ->
      let b1 = (b+1) % points_max in
      do
        stelem<PointF>(points_loop, 0, ldelem<PointF>(points, points_max-3));
        stelem<PointF>(points_loop, 1, ldelem<PointF>(points, points_max-2));
        stelem<PointF>(points_loop, 2, ldelem<PointF>(points, points_max-1));
        stelem<PointF>(points_loop, 3, ldelem<PointF>(points, 0));
        stelem<PointF>(points_loop, 4, ldelem<PointF>(points, 1));
        points_begin := b1;
      end else ();
    point := p;
    redraw (); 
  end;

let draw_main (gr : {Graphics}) =
  let ((ro,ri,d), ((xo,yo) as co), _) = get_state () in
  let rd = ro-.ri in
  let (xi_,yi_) as ci_ = (xo +. rd *. cos !theta, yo +. rd *. sin !theta) in
  let p = !point in
  let pe = ldelem<PointF>(points, (!points_end + points_max-2) % points_max) in
  let (b,e) = (!points_begin, !points_end) in
  let n = if b < e -> e-b-1 else points_max-b-1 in
  let m = if b < e -> 0 else e-1 in
  let pen = gradient_pen in
  do
    gr.set_SmoothingMode(sget Drawing2D.SmoothingMode::AntiAlias);
    gx_clear gr white_brush;
    if !show_circle -> do
      gx_draw_circle gr mokkosu_pen co ro;
      gx_draw_circle gr mokkosu_pen ci_ ri;
      gx_draw_line gr mokkosu_pen ci_ p;
      gx_draw_circle gr mokkosu_pen p 8.0;
    end else ();
    if n > 0 -> gx_draw_curve_ofs gr pen points b n else ();
    if m > 0 -> do
      gx_draw_curve_ofs gr pen points_loop 2 1;
      gx_draw_curve_ofs gr pen points 0 m;
    end else ();
  end;

#-----------------------------------------------------------------------------
# Main
#-----------------------------------------------------------------------------
let main () = do
  # setup window
  set_size screen_width screen_height;
  set_title title;
  set_speed fps_inv;

  # init
  scene "init" {
    ~Tick -> tick_init ();
    _ -> (); 
  };

  # main
  scene "main" {
    ~Tick -> tick_main ();
    ~MouseDown(LeftButton,_,_) -> pause := not !pause;
    ~MouseDown(RightButton,_,_) -> show_circle := not !show_circle;
    ~Draw(gr) -> draw_main gr;
    _ -> ();
  };

  # startup
  show_window "init";
  end;

#-----------------------------------------------------------------------------
# Entry point
#-----------------------------------------------------------------------------
do main ();

解説

Mokkosu 1.3.1 から追加された array を使用しています。というか、これがないと .NET の DrawCurve 関数が使えませんでした。

感想

.NET の配列を Mokkosu から自然に扱えるようになっていい感じと思いました。