1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
|
(*
**
** ATS/Cairo Tutorial:
** drawing rectangles and circles
**
** Author: Hongwei Xi (hwxi AT cs DOT bu DOT edu)
** Time: 2010-04
**
*)
(*
** Copyright (C) 2009-2010 Hongwei Xi, Boston University
**
** Permission is hereby granted, free of charge, to any person
** obtaining a copy of this software and associated documentation
** files (the "Software"), to deal in the Software without
** restriction, including without limitation the rights to use,
** copy, modify, merge, publish, distribute, sublicense, and/or sell
** copies of the Software, and to permit persons to whom the
** Software is furnished to do so, subject to the following
** conditions:
**
** The above copyright notice and this permission notice shall be
** included in all copies or substantial portions of the Software.
**
** THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
** EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES
** OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
** NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT
** HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
** WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
** FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR
** OTHER DEALINGS IN THE SOFTWARE.
*)
(* ****** ****** *)
(*
** Ported to ATS2 by Hongwei Xi, September, 2013
*)
(* ****** ****** *)
//
// How to compile:
// patscc -I${PATSHOME}/contrib -o tutprog_sqrcirc tutprog_sqrcirc.dats `pkg-config cairo --cflags --libs`
//
// How to test: ./tutprog_sqrcirc
//
(* ****** ****** *)
//
#include
"share/atspre_staload.hats"
//
(* ****** ****** *)
//
#staload
MATH =
"libats/libc/SATS/math.sats"
//
(* ****** ****** *)
//
#define
LIBCAIRO_targetloc
"\
$PATSHOME/\
npm-utils/contrib\
/atscntrb/atscntrb-hx-libcairo"
//
(* ****** ****** *)
//
#include
"{$LIBCAIRO}/mylibies.hats"
#staload $CAIRO // opening it!
//
(* ****** ****** *)
//
macdef PI = $MATH.M_PI
//
(* ****** ****** *)
fun draw_sqrcirc {l:agz}
(cr: !cairo_ref l): void = let
val () = cairo_rectangle (cr, ~0.5, ~0.5, 1.0, 1.0)
val () = cairo_set_source_rgb (cr, 0.0, 0.0, 0.0) // black color
val () = cairo_fill (cr)
val () = cairo_arc (cr, 0.0, 0.0, 0.5, 0.0, 2*PI)
val () = cairo_set_source_rgb (cr, 1.0, 1.0, 1.0) // white color
val () = cairo_fill (cr)
in
// nothing
end // end of [draw_sqrcirc]
(* ****** ****** *)
implement
main0 () = () where {
//
val W = 250 and H = 250
//
// create a sf for drawing
//
val sf =
cairo_image_surface_create (CAIRO_FORMAT_ARGB32, W, H)
val cr = cairo_create (sf)
//
val WH = min (W, H)
val WH = g0int2float_int_double (WH)
//
val (pf0 | ()) = cairo_save (cr)
val () = cairo_translate (cr, WH/2, WH/2)
val () = cairo_scale (cr, WH, WH)
val () = draw_sqrcirc (cr)
val () = cairo_restore (pf0 | cr)
//
val status =
cairo_surface_write_to_png (sf, "tutprog_sqrcirc.png")
val () = cairo_surface_destroy (sf) // a type error if omitted
val () = cairo_destroy (cr) // a type error if omitted
//
// in case of a failure ...
//
val () = assertloc (status = CAIRO_STATUS_SUCCESS)
//
} (* end of [main0] *)
(* ****** ****** *)
(* end of [tutprog_sqrcirc.dats] *)
|
