Skip to content

Commit e1ad316

Browse files
vmagninvmagnin
committed
test/test?.f90: improved layout
1 parent f2ed1d8 commit e1ad316

File tree

3 files changed

+166
-163
lines changed

3 files changed

+166
-163
lines changed

‎test/test1.f90

+27-26
Original file line numberDiff line numberDiff line change
@@ -1,34 +1,35 @@
11
program test1
2-
use cairo
3-
use cairo_enums
4-
use iso_c_binding, only: c_ptr, c_int, c_null_char
5-
implicit none
6-
type(c_ptr) :: surface, c
7-
integer(c_int) :: r
2+
use cairo
3+
use cairo_enums
84

9-
! Initialize
10-
surface = cairo_image_surface_create(CAIRO_FORMAT_ARGB32, 200, 200)
11-
c = cairo_create(surface)
5+
implicit none
6+
type(c_ptr) :: surface, c
7+
integer(c_int) :: r
128

13-
! Set background colour
14-
call cairo_set_source_rgb(c, 0.45098039d0, 0.30980392d0, 0.58823529d0)
15-
call cairo_move_to(c, 0.d0, 0.d0)
16-
call cairo_rectangle(c, 0.d0, 0.d0, 200.d0, 200.d0)
17-
call cairo_fill(c)
9+
! Initialize
10+
surface = cairo_image_surface_create(CAIRO_FORMAT_ARGB32, 200, 200)
11+
c = cairo_create(surface)
1812

19-
! Draw 'F'
20-
call cairo_set_source_rgb(c, 1.d0, 1.d0, 1.d0)
21-
call cairo_select_font_face(c, "Clarendon BT Roman"//c_null_char, CAIRO_FONT_SLANT_NORMAL, CAIRO_FONT_WEIGHT_NORMAL)
22-
call cairo_set_font_size(c, 72.0d0)
23-
call cairo_move_to(c, 40d0, 80d0)
24-
call cairo_show_text(c, "F"//c_null_char)
25-
call cairo_stroke(c)
13+
! Set background colour
14+
call cairo_set_source_rgb(c, 0.45098039d0, 0.30980392d0, 0.58823529d0)
15+
call cairo_move_to(c, 0.d0, 0.d0)
16+
call cairo_rectangle(c, 0.d0, 0.d0, 200.d0, 200.d0)
17+
call cairo_fill(c)
2618

27-
! Write .png
28-
r = cairo_surface_write_to_png(surface, "F.png"//c_null_char)
19+
! Draw 'F'
20+
call cairo_set_source_rgb(c, 1.d0, 1.d0, 1.d0)
21+
call cairo_select_font_face(c, "Clarendon BT Roman"//c_null_char, &
22+
& CAIRO_FONT_SLANT_NORMAL, CAIRO_FONT_WEIGHT_NORMAL)
23+
call cairo_set_font_size(c, 72.0d0)
24+
call cairo_move_to(c, 40d0, 80d0)
25+
call cairo_show_text(c, "F"//c_null_char)
26+
call cairo_stroke(c)
2927

30-
! Destroy
31-
call cairo_destroy(c)
32-
call cairo_surface_destroy(surface)
28+
! Write .png
29+
r = cairo_surface_write_to_png(surface, "F.png"//c_null_char)
30+
31+
! Destroy
32+
call cairo_destroy(c)
33+
call cairo_surface_destroy(surface)
3334

3435
end program test1

‎test/test2.f90

+92-91
Original file line numberDiff line numberDiff line change
@@ -12,103 +12,104 @@
1212
! - Save the image to disk
1313

1414
program test2
15-
use cairo
16-
use cairo_enums
17-
use cairo_types, only: cairo_matrix_t
18-
use iso_c_binding, only: c_ptr, c_int, c_double, c_null_char, c_loc
19-
20-
implicit none
21-
type(c_ptr) :: surface, c
22-
integer(c_int) :: r
23-
real(c_double), parameter :: IMAGE_WIDTH = 480.0d0
24-
real(c_double), parameter :: IMAGE_HEIGHT = IMAGE_WIDTH
25-
real(c_double), parameter :: WORKSPACE_SIZE = 100.d0
26-
real(c_double), parameter :: WORKSPACE_FACTOR = IMAGE_WIDTH/WORKSPACE_SIZE
27-
real(c_double), parameter :: WORKSPACE_HALF = WORKSPACE_SIZE/2.0d0
28-
integer, parameter :: GRID_STEP = int(WORKSPACE_SIZE/10.0)
29-
integer, parameter :: NUM_POINTS = 500
30-
real :: t(NUM_POINTS)
31-
real :: y(NUM_POINTS)
32-
real, parameter :: PLOT_STEP = real(WORKSPACE_SIZE)/NUM_POINTS
33-
type(cairo_matrix_t), target :: m
34-
integer :: i
35-
36-
! Initialize
37-
surface = cairo_image_surface_create(CAIRO_FORMAT_ARGB32, int(IMAGE_WIDTH), int(IMAGE_HEIGHT))
38-
c = cairo_create(surface)
39-
call cairo_set_antialias(c, CAIRO_ANTIALIAS_BEST)
40-
41-
! Set background colour
42-
call cairo_set_source_rgb(c, 0.05d0, 0.05d0, 0.05d0)
43-
call cairo_move_to(c, 0.d0, 0.d0)
44-
call cairo_rectangle(c, 0.d0, 0.d0, IMAGE_WIDTH, IMAGE_HEIGHT)
45-
call cairo_fill(c)
46-
47-
! Move origin, invert Y-axis
48-
call cairo_matrix_init(c_loc(m), +WORKSPACE_FACTOR, 0.0d0, 0.0d0, -WORKSPACE_FACTOR, IMAGE_WIDTH/2.0d0, IMAGE_HEIGHT/2.0d0)
49-
call cairo_transform(c, c_loc(m))
50-
51-
! Draw grid
52-
do i = -int(WORKSPACE_HALF - GRID_STEP), int(WORKSPACE_HALF - GRID_STEP), GRID_STEP
53-
if (i .eq. 0) then
54-
call cairo_set_line_width(c, 0.25d0)
55-
call cairo_set_source_rgb(c, 1.0d0, 1.0d0, 1.0d0)
56-
else
57-
call cairo_set_line_width(c, 0.05d0)
58-
call cairo_set_source_rgb(c, 0.8d0, 0.8d0, 0.8d0)
59-
end if
60-
61-
! Vertical lines
62-
call cairo_move_to(c, real(i, kind=c_double), -WORKSPACE_HALF)
63-
call cairo_line_to(c, real(i, kind=c_double), +WORKSPACE_HALF)
15+
use cairo
16+
use cairo_enums
17+
use cairo_types, only: cairo_matrix_t
18+
19+
implicit none
20+
type(c_ptr) :: surface, c
21+
integer(c_int) :: r
22+
real(c_double), parameter :: IMAGE_WIDTH = 480.0d0
23+
real(c_double), parameter :: IMAGE_HEIGHT = IMAGE_WIDTH
24+
real(c_double), parameter :: WORKSPACE_SIZE = 100.d0
25+
real(c_double), parameter :: WORKSPACE_FACTOR = IMAGE_WIDTH/WORKSPACE_SIZE
26+
real(c_double), parameter :: WORKSPACE_HALF = WORKSPACE_SIZE/2.0d0
27+
integer, parameter :: GRID_STEP = int(WORKSPACE_SIZE/10.0)
28+
integer, parameter :: NUM_POINTS = 500
29+
real :: t(NUM_POINTS)
30+
real :: y(NUM_POINTS)
31+
real, parameter :: PLOT_STEP = real(WORKSPACE_SIZE)/NUM_POINTS
32+
type(cairo_matrix_t), target :: m
33+
integer :: i
34+
35+
! Initialize
36+
surface = cairo_image_surface_create(CAIRO_FORMAT_ARGB32, &
37+
& int(IMAGE_WIDTH), int(IMAGE_HEIGHT))
38+
c = cairo_create(surface)
39+
call cairo_set_antialias(c, CAIRO_ANTIALIAS_BEST)
40+
41+
! Set background colour
42+
call cairo_set_source_rgb(c, 0.05d0, 0.05d0, 0.05d0)
43+
call cairo_move_to(c, 0.d0, 0.d0)
44+
call cairo_rectangle(c, 0.d0, 0.d0, IMAGE_WIDTH, IMAGE_HEIGHT)
45+
call cairo_fill(c)
46+
47+
! Move origin, invert Y-axis
48+
call cairo_matrix_init(c_loc(m), +WORKSPACE_FACTOR, 0.0d0, 0.0d0, &
49+
& -WORKSPACE_FACTOR, IMAGE_WIDTH/2.0d0, IMAGE_HEIGHT/2.0d0)
50+
call cairo_transform(c, c_loc(m))
51+
52+
! Draw grid
53+
do i = -int(WORKSPACE_HALF - GRID_STEP), int(WORKSPACE_HALF - GRID_STEP), GRID_STEP
54+
if (i .eq. 0) then
55+
call cairo_set_line_width(c, 0.25d0)
56+
call cairo_set_source_rgb(c, 1.0d0, 1.0d0, 1.0d0)
57+
else
58+
call cairo_set_line_width(c, 0.05d0)
59+
call cairo_set_source_rgb(c, 0.8d0, 0.8d0, 0.8d0)
60+
end if
61+
62+
! Vertical lines
63+
call cairo_move_to(c, real(i, kind=c_double), -WORKSPACE_HALF)
64+
call cairo_line_to(c, real(i, kind=c_double), +WORKSPACE_HALF)
65+
call cairo_stroke(c)
66+
67+
! Horizontal lines
68+
call cairo_move_to(c, -WORKSPACE_HALF, real(i, kind=c_double))
69+
call cairo_line_to(c, +WORKSPACE_HALF, real(i, kind=c_double))
70+
call cairo_stroke(c)
71+
end do
72+
73+
! Poor man linspace()
74+
do i = 1, size(t)
75+
t(i) = -real(WORKSPACE_HALF) + PLOT_STEP*real(i)
76+
end do
77+
78+
y = current(I=20.0, omega=0.22, t=t, phi=0.0)
79+
80+
! Draw function points
81+
call cairo_set_line_width(c, 0.5d0)
82+
call cairo_set_source_rgb(c, 0.95d0, 0.0230d0, 0.95330d0)
83+
call cairo_move_to(c, real(t(1), kind=c_double), real(y(1), kind=c_double))
84+
do i = 2, size(t) - 1
85+
call cairo_line_to(c, real(t(i), kind=c_double), real(y(i), kind=c_double))
86+
end do
6487
call cairo_stroke(c)
6588

66-
! Horizontal lines
67-
call cairo_move_to(c, -WORKSPACE_HALF, real(i, kind=c_double))
68-
call cairo_line_to(c, +WORKSPACE_HALF, real(i, kind=c_double))
89+
! Draw Green Line
90+
call cairo_set_line_width(c, 1.0d0)
91+
call cairo_set_source_rgb(c, 0.05d0, 0.9230d0, 0.05330d0)
92+
call cairo_move_to(c, -40.d0, -40.d0)
93+
call cairo_line_to(c, 40.d0, -40.d0)
6994
call cairo_stroke(c)
70-
end do
71-
72-
! Poor man linspace()
73-
do i = 1, size(t)
74-
t(i) = -real(WORKSPACE_HALF) + PLOT_STEP*real(i)
75-
end do
76-
77-
y = current(I=20.0, omega=0.22, t=t, phi=0.0)
78-
79-
! Draw function points
80-
call cairo_set_line_width(c, 0.5d0)
81-
call cairo_set_source_rgb(c, 0.95d0, 0.0230d0, 0.95330d0)
82-
call cairo_move_to(c, real(t(1), kind=c_double), real(y(1), kind=c_double))
83-
do i = 2, size(t) - 1
84-
call cairo_line_to(c, real(t(i), kind=c_double), real(y(i), kind=c_double))
85-
end do
86-
call cairo_stroke(c)
87-
88-
! Draw Green Line
89-
call cairo_set_line_width(c, 1.0d0)
90-
call cairo_set_source_rgb(c, 0.05d0, 0.9230d0, 0.05330d0)
91-
call cairo_move_to(c, -40.d0, -40.d0)
92-
call cairo_line_to(c, 40.d0, -40.d0)
93-
call cairo_stroke(c)
94-
95-
! Write .png
96-
r = cairo_surface_write_to_png(surface, "axis.png"//c_null_char)
97-
98-
! Destroy
99-
call cairo_destroy(c)
100-
call cairo_surface_destroy(surface)
95+
96+
! Write .png
97+
r = cairo_surface_write_to_png(surface, "axis.png"//c_null_char)
98+
99+
! Destroy
100+
call cairo_destroy(c)
101+
call cairo_surface_destroy(surface)
101102

102103
contains
103104

104-
elemental pure function current(I, omega, t, phi) result(r)
105-
real, intent(in) :: I
106-
real, intent(in) :: omega
107-
real, intent(in) :: t
108-
real, intent(in) :: phi
109-
real :: r
105+
elemental pure function current(I, omega, t, phi) result(r)
106+
real, intent(in) :: I
107+
real, intent(in) :: omega
108+
real, intent(in) :: t
109+
real, intent(in) :: phi
110+
real :: r
110111

111-
r = I*abs(cos(omega*t + phi))
112-
end function
112+
r = I*abs(cos(omega*t + phi))
113+
end function
113114

114115
end program test2

‎test/test4.f90

+47-46
Original file line numberDiff line numberDiff line change
@@ -7,54 +7,55 @@
77
! - Save image to disk
88

99
program test4
10-
use cairo
11-
use cairo_enums
12-
use cairo_types, only: cairo_matrix_t
13-
use iso_c_binding, only: c_ptr, c_int, c_double, c_null_char, c_loc
14-
15-
implicit none
16-
type(c_ptr) :: surface, c
17-
integer(c_int) :: r
18-
real(c_double), parameter :: IMAGE_WIDTH = 480.0d0
19-
real(c_double), parameter :: IMAGE_HEIGHT = IMAGE_WIDTH
20-
real(c_double), parameter :: WORKSPACE_SIZE = 8.d0
21-
real(c_double), parameter :: WORKSPACE_FACTOR = IMAGE_WIDTH/WORKSPACE_SIZE
22-
type(cairo_matrix_t), target :: m
23-
integer :: i, j
24-
25-
! Initialize
26-
surface = cairo_image_surface_create(CAIRO_FORMAT_ARGB32, int(IMAGE_WIDTH), int(IMAGE_HEIGHT))
27-
c = cairo_create(surface)
28-
call cairo_set_antialias(c, CAIRO_ANTIALIAS_BEST)
29-
30-
! Transform image coordinates (480x480) to my internal workspace (8x8)
31-
call cairo_matrix_init(c_loc(m), +WORKSPACE_FACTOR, 0.0d0, 0.0d0, +WORKSPACE_FACTOR, 0.0d0, 0.0d0)
32-
call cairo_transform(c, c_loc(m))
33-
34-
! Draw board
35-
do i = 1, 8, 1
36-
do j = 1, 8, 1
37-
38-
! Which color?
39-
if (mod(i + j, 2) .eq. 0) then
40-
call cairo_set_source_rgb(c, 1.0d0, 0.8d0, 0.7d0)
41-
else
42-
call cairo_set_source_rgb(c, 0.1d0, 0.1d0, 0.1d0)
43-
end if
44-
45-
! Draw square
46-
call cairo_rectangle(c, real(j, kind=c_double) - 1.d0, &
47-
real(i, kind=c_double) - 1.d0, 1.d0, 1.d0)
48-
call cairo_fill(c)
49-
10+
use cairo
11+
use cairo_enums
12+
use cairo_types, only: cairo_matrix_t
13+
14+
implicit none
15+
type(c_ptr) :: surface, c
16+
integer(c_int) :: r
17+
real(c_double), parameter :: IMAGE_WIDTH = 480.0d0
18+
real(c_double), parameter :: IMAGE_HEIGHT = IMAGE_WIDTH
19+
real(c_double), parameter :: WORKSPACE_SIZE = 8.d0
20+
real(c_double), parameter :: WORKSPACE_FACTOR = IMAGE_WIDTH/WORKSPACE_SIZE
21+
type(cairo_matrix_t), target :: m
22+
integer :: i, j
23+
24+
! Initialize
25+
surface = cairo_image_surface_create(CAIRO_FORMAT_ARGB32, &
26+
& int(IMAGE_WIDTH), int(IMAGE_HEIGHT))
27+
c = cairo_create(surface)
28+
call cairo_set_antialias(c, CAIRO_ANTIALIAS_BEST)
29+
30+
! Transform image coordinates (480x480) to my internal workspace (8x8)
31+
call cairo_matrix_init(c_loc(m), +WORKSPACE_FACTOR, 0.0d0, 0.0d0, &
32+
& +WORKSPACE_FACTOR, 0.0d0, 0.0d0)
33+
call cairo_transform(c, c_loc(m))
34+
35+
! Draw board
36+
do i = 1, 8, 1
37+
do j = 1, 8, 1
38+
39+
! Which color?
40+
if (mod(i + j, 2) .eq. 0) then
41+
call cairo_set_source_rgb(c, 1.0d0, 0.8d0, 0.7d0)
42+
else
43+
call cairo_set_source_rgb(c, 0.1d0, 0.1d0, 0.1d0)
44+
end if
45+
46+
! Draw square
47+
call cairo_rectangle(c, real(j, kind=c_double) - 1.d0, &
48+
& real(i, kind=c_double) - 1.d0, 1.d0, 1.d0)
49+
call cairo_fill(c)
50+
51+
end do
5052
end do
51-
end do
5253

53-
! Write .png
54-
r = cairo_surface_write_to_png(surface, "chess.png"//c_null_char)
54+
! Write .png
55+
r = cairo_surface_write_to_png(surface, "chess.png"//c_null_char)
5556

56-
! Destroy
57-
call cairo_destroy(c)
58-
call cairo_surface_destroy(surface)
57+
! Destroy
58+
call cairo_destroy(c)
59+
call cairo_surface_destroy(surface)
5960

6061
end program test4

0 commit comments

Comments
 (0)