fortran66のブログ

fortran について書きます。

【メモ帳】M1 Mac でも阿部さん

我が Mac でも X window が使える様になったので

Mac を買ったら初心に帰って最初にやろうと思っていた阿部さん作画に挑戦しました。

買ったばかりの頃は XQuartz がベータ版だったせいか、うまく include ファイルやライブラリを見つける事ができず断念していましたが、今や機は熟しました!

直線は点を連続打ちすることにします。

実行結果

f:id:fortran66:20210331194806p:plain
阿部さん

fortran66.hatenablog.com fortran66.hatenablog.com fortran66.hatenablog.com

 gfortran plot3.c abe3.f90 -lX11 -I/opt/X11/include -L/opt/X11/lib

ソース・プログラム

plot3.c

#include <X11/Xlib.h>
#include <X11/Xutil.h>
static Display* d;
static Window   w;
static GC       gc;
unsigned long white, black;

void X_open(int nx, int ny){
    // Open a display
    d = XOpenDisplay(0);
    if ( !d ) return;
    //
    white = WhitePixel(d, DefaultScreen(d));
    black = BlackPixel(d, DefaultScreen(d));
    // Create a window
    w = XCreateSimpleWindow(d, DefaultRootWindow(d), 0, 0, nx, ny, 0, black, white);
    XMapWindow(d, w);
    gc = XCreateGC(d, w, 0, 0);
    XFlush(d);
}

void X_point(int ix, int iy){
     XDrawPoint(d, w, gc, ix, iy);
     XFlush(d);
}

void X_flush(){
     XFlush(d);
}

void X_close(void){
    XFreeGC(d, gc);
    XDestroyWindow(d, w);
    XFlush(d);
    XCloseDisplay(d);
}

abe3.f90

module plot_m
    implicit none
    interface
         subroutine Xopen(nx, ny) bind(c, name = 'X_open')
             integer, value :: nx, ny
         end subroutine Xopen

         subroutine Xpoint(ix, iy) bind(c, name = 'X_point')
             integer, value :: ix, iy
         end subroutine Xpoint

         subroutine Xclose() bind(c, name = 'X_close')
         end subroutine Xclose

         subroutine Xflush() bind(c, name = 'X_flush')
         end subroutine Xflush
     end interface
contains

    subroutine line0(ix0, iy0, ix1, iy1)
         integer, intent(in) :: ix0, iy0, ix1, iy1
         integer :: nx, ny, i
         real  :: d
         nx = ix1 - ix0
         ny = iy1 - iy0            
         if (abs(nx) < abs(ny)) then
            d = nx / real(ny)
            do i = 0, ny, sign(1, ny) 
                call Xpoint(nint(ix0 + i * d), iy0 + i)
            end do    
        else
            d = ny / real(nx)
            do i = 0, nx, sign(1, nx)
                call Xpoint(ix0 + i, nint(iy0 + i * d))
            end do    
        end if
    end subroutine line0

    subroutine line(x, y, ipen)
        real, intent(in) :: x, y
        integer, intent(in) :: ipen
        integer, save :: ix0 = 0, iy0 = 0
        integer :: ix, iy
        integer, parameter :: kx = 250, ky = 600, k = 4
        ix = int( k * x + kx)
        iy = int(-k * y + ky)
        if (ipen == 1) call line0(ix0, iy0, ix, iy)
        ix0 = ix 
        iy0 = iy
    end subroutine line    
end module plot_m


program abe3
    use plot_m
    implicit none

    call Xopen(500, 600)
    call sleep(1)                              ! non-standard
    
    ! chin 
    call line(  0.0,  32.0, 0)
    call line(  0.0,  35.0, 1)
    
    ! collar
    call line(  8.0,   0.0, 0)
    call line( 22.0,  25.0, 1)
    call line( 30.0,  55.0, 1)
    
    call line( 19.0,   0.0, 0)
    call line( 25.0,  10.0, 1)
    call line( 47.0,  20.0, 1)
    call line( 35.0,  40.0, 1)
    call line( 55.0,  35.0, 1)
    call line( 35.0,  40.0, 0)
    call line( 30.0,  55.0, 1)
    
    
    call line( 13.0,  20.0, 0)
    call line( 24.0,  44.0, 1)
    
    call line( -8.0,   0.0, 0)
    call line(-22.0,  25.0, 1)
    call line(-30.0,  55.0, 1)
    
    call line(-19.0,   0.0, 0)
    call line(-25.0,  10.0, 1)
    call line(-47.0,  20.0, 1)
    call line(-35.0,  40.0, 1)
    call line(-55.0,  35.0, 1)
    call line(-35.0,  40.0, 0)
    call line(-30.0,  55.0, 1)
    
    call line(-13.0,  20.0, 0)
    call line(-24.0,  44.0, 1)
    !
    call line(  0.0,  26.0, 0)
    call line(  4.0,  26.0, 1)
    call line( 14.0,  30.0, 1)
    call line( 24.0,  44.0, 1)
    call line( 30.0,  55.0, 1)
    call line( 33.0,  65.0, 1)
    call line( 33.0, 120.0, 1)
    call line(  2.0, 120.0, 1)
    call line(  2.0, 115.0, 1)
    call line(  0.0, 106.0, 1)
    call line( -2.0, 103.0, 1)
    !
    call line(  0.0,  26.0, 0)
    call line( -4.0,  26.0, 1)
    call line(-14.0,  30.0, 1)
    call line(-24.0,  44.0, 1)
    call line(-30.0,  55.0, 1)
    call line(-33.0,  65.0, 1)
    call line(-33.0, 120.0, 1)
    call line(  0.0, 120.0, 1)
    call line(  0.0, 110.0, 1)
    call line( -2.0, 103.0, 1)
    !right ear
    call line( 33.0,  65.0, 0)
    call line( 42.0,  77.0, 1)
    call line( 42.0,  89.0, 1)
    call line( 40.0,  93.0, 1)
    call line( 36.0,  93.0, 1)
    call line( 34.0,  86.0, 1)
    call line( 33.0,  84.0, 1)
    call line( 34.0,  86.0, 0)
    call line( 36.0,  84.0, 1)
    call line( 36.0,  74.0, 1)
    call line( 33.0,  69.0, 1)
    !left ear
    call line(-33.0,  65.0, 0)
    call line(-42.0,  77.0, 1)
    call line(-42.0,  89.0, 1)
    call line(-40.0,  93.0, 1)
    call line(-36.0,  93.0, 1)
    call line(-34.0,  86.0, 1)
    call line(-33.0,  84.0, 1)
    call line(-34.0,  86.0, 0)
    call line(-36.0,  84.0, 1)
    call line(-36.0,  74.0, 1)
    call line(-33.0,  69.0, 1)
    ! hair
    call line( 40.0,  93.0, 0)
    call line( 40.0, 120.0, 1)
    call line( 33.0, 135.0, 1)
    call line( 14.0, 147.0, 1)
    call line(-14.0, 147.0, 1)
    call line(-33.0, 135.0, 1)
    call line(-40.0, 120.0, 1)
    call line(-40.0,  93.0, 1)
    ! mouth
    call line(-15.0,  54.0, 0)
    call line(-14.0,  53.0, 1)
    call line( -6.0,  53.0, 1)
    call line( -5.0,  52.0, 1)
    call line( -1.0,  52.0, 0)
    call line(  7.0,  53.0, 1)
    call line( 10.0,  52.0, 1)
    call line( 11.0,  53.0, 1)
    !
    call line( -6.0,  45.0, 0)
    call line( -5.0,  44.0, 1)
    call line(  5.0,  44.0, 1)
    call line(  6.0,  45.0, 0)
    ! nose
    call line(  2.0,  65.0, 0)
    call line(  2.0,  64.0, 1)
    call line(  0.0,  62.0, 1)
    call line( -4.0,  64.0, 1)
    call line( -6.0,  62.0, 1)
    call line(  0.0,  59.0, 1)
    call line(  5.0,  61.0, 1)
    call line(  5.0,  66.0, 1)
    call line(  4.0,  66.0, 1)
    call line(  2.0,  68.0, 1)
    call line(  2.0,  87.0, 1)
    call line(  6.0,  92.0, 1)
    call line(  5.0,  95.0, 1)
    !
    call line(  3.0,  72.0, 0)
    call line(  3.0,  86.0, 1)
    call line(  4.0,  87.0, 1)
    call line(  7.0,  77.0, 1)
    call line(  3.0,  72.0, 1)
    ! right eye
    call line(  5.0,  95.0, 0)
    call line(  7.0,  97.0, 1)
    call line( 30.0,  97.0, 1)
    call line( 32.0,  93.0, 1)
    call line( 25.0,  94.0, 1)
    call line( 12.0,  94.0, 1)
    call line(  5.0,  95.0, 1)
    call line( 10.0,  93.0, 0)
    call line( 12.0,  94.0, 1)
    call line( 29.0,  90.0, 0)
    call line( 25.0,  94.0, 1)
    !
    call line( 14.0,  85.0, 0)
    call line( 18.0,  85.0, 1)
    call line( 19.0,  84.0, 1)
    call line( 20.0,  85.0, 1)
    call line( 23.0,  84.0, 1)
    !
    call line( 10.0,  83.0, 0)
    call line( 18.0,  82.0, 1)
    call line( 20.0,  81.0, 1)
    !
    call line( 18.0,  90.0, 0)
    call line( 20.0,  90.0, 1)
    call line( 20.0,  92.0, 1)
    call line( 18.0,  92.0, 1)
    call line( 18.0,  90.0, 1)
    !
    call line( 10.0,  91.0, 0)
    call line( 15.0,  94.0, 1)
    call line( 23.0,  94.0, 1)
    call line( 27.0,  91.0, 1)
    call line( 29.0,  87.0, 1)
    call line( 28.0,  87.0, 1)
    call line( 27.0,  90.0, 1)
    call line( 23.0,  93.0, 1)
    call line( 23.0,  89.0, 1)
    call line( 21.0,  87.0, 1)
    call line( 17.0,  87.0, 1)
    call line( 15.0,  89.0, 1)
    call line( 15.0,  91.0, 1)
    call line( 16.0,  93.0, 1)
    call line( 11.0,  90.0, 1)
    call line( 10.0,  91.0, 1)
    ! left eye
    call line(-33.0,  95.0, 0)
    call line(-30.0,  99.0, 1)
    call line(-12.0,  99.0, 1)
    call line( -7.0,  96.0, 1)
    call line(-10.0,  94.0, 1)
    call line(-14.0,  95.0, 1)
    call line(-33.0,  95.0, 1)
    call line(-11.0,  92.0, 0)
    call line(-14.0,  95.0, 1)
    ! 
    call line(-23.0,  82.0, 0) 
    call line(-21.0,  81.0, 1) 
    call line(-14.0,  84.0, 1) 
    !
    call line(-27.0,  86.0, 0) 
    call line(-21.0,  85.0, 1) 
    call line(-15.0,  86.0, 1) 
    !
    call line(-29.0,  90.0, 0)
    call line(-25.0,  94.0, 1)
    call line(-15.0,  94.0, 1)
    call line(-12.0,  91.0, 1)
    call line(-13.0,  90.0, 1)
    call line(-16.0,  92.0, 1)
    call line(-17.0,  90.0, 1)
    call line(-18.0,  87.0, 1)
    call line(-22.0,  87.0, 1)
    call line(-24.0,  89.0, 1)
    call line(-24.0,  92.0, 1)
    call line(-28.0,  89.0, 1)
    call line(-29.0,  90.0, 1)
    !
    call line(-19.0,  90.0, 0)
    call line(-21.0,  90.0, 1)
    call line(-21.0,  92.0, 1)
    call line(-19.0,  92.0, 1)
    call line(-19.0,  90.0, 1)
   read *
    call Xflush()
    call Xclose()
end program abe3

shonben.f90

module plot_m
    implicit none
    interface
         subroutine Xopen(nx, ny) bind(c, name = 'X_open')
             integer, value :: nx, ny
         end subroutine Xopen

         subroutine Xpoint(ix, iy) bind(c, name = 'X_point')
             integer, value :: ix, iy
         end subroutine Xpoint

         subroutine Xclose() bind(c, name = 'X_close')
         end subroutine Xclose

         subroutine Xflush() bind(c, name = 'X_flush')
         end subroutine Xflush
     end interface
contains

    subroutine line0(ix0, iy0, ix1, iy1)
        integer, intent(in) :: ix0, iy0, ix1, iy1
        integer :: nx, ny, i
        real  :: d
        nx = ix1 - ix0
        ny = iy1 - iy0            
        if (abs(nx) < abs(ny)) then
            d = nx / real(ny)
            do i = 0, ny, sign(1, ny) 
                call Xpoint(nint(ix0 + i * d), iy0 + i)
            end do    
        else
            d = ny / real(nx)
            do i = 0, nx, sign(1, nx)
                call Xpoint(ix0 + i, nint(iy0 + i * d))
            end do    
        end if
    end subroutine line0

    subroutine line(x, y, ipen)
        real, intent(in) :: x, y
        integer, intent(in) :: ipen
        integer, save :: ix0 = 0, iy0 = 0
        integer :: ix, iy
        integer, parameter :: kx = 250, ky = 420, k = 4
        ix = int( k * x + kx)
        iy = int(-k * y + ky)
        if (ipen == 1) call line0(ix0, iy0, ix, iy)
        ix0 =  ix 
        iy0 =  iy
    end subroutine line    
end module plot_m


program shonben
    use plot_m
    implicit none

    call Xopen(500, 600)
    call sleep(1)                              ! non-standard
    ! chin chin
    call line(  0.0,  11.0, 0)
    call line(  0.0,   8.0, 1)    

    call line( -8.0, -26.5, 0)
    call line(-11.0, -24.0, 1)
    call line(  8.0, -26.5, 0)
    call line( 11.0, -24.0, 1)    

    call line(  5.5, -26.0, 0)
    call line(  2.0, -36.0, 1)
    call line( -5.5, -26.0, 0)
    call line( -2.0, -36.0, 1)    

    call line( 20.0, -18.0, 0)
    call line(  8.5, -19.0, 1)
    call line(  4.0, -21.5, 1)
    call line(  0.0, -23.0, 1)
    call line( -4.0, -21.5, 1)
    call line( -8.5, -19.0, 1)
    call line(-20.0, -18.0, 1)    

    call line( 12.0, -16.0, 0)
    call line( 22.0,  14.0, 1)
    call line(-12.0, -16.0, 0)
    call line(-22.0,  14.0, 1)
     
    call line( 53.0,  -9.0, 0)
    call line( 28.5,   1.0, 1)
    call line( 28.5, -14.0, 0)
    call line( 28.5,  25.0, 1)
    call line( 28.5,  33.0, 0)
    call line( 28.5,  76.0, 1)
    call line( -2.5,  76.0, 1)
    call line( -2.5,  72.0, 1)
    call line( -0.5,  68.0, 1)
    call line(  1.0,  66.0, 1)
    call line( -1.5,  67.0, 1)
    call line( -4.0,  72.0, 1)
    call line( -4.0,  76.0, 1)
    call line(-28.5,  76.0, 1)
    call line(-28.5,  33.0, 1)    

    call line(-28.5,  25.0, 0)
    call line(-28.5, -14.0, 1)
    call line(-53.0,  -9.0, 0)
    call line(-28.5,   1.0, 1)     

    call line(  0.0,   0.0, 0)
    call line(  6.5,   0.0, 1)
    call line( 10.0,   3.0, 1)
    call line( 15.0,   7.0, 1)
    call line( 22.0,  14.0, 1)
    call line( 28.5,  25.0, 1)
    call line( 31.0,  26.0, 1)
    call line( 35.0,  34.0, 1)
    call line( 38.0,  44.0, 1)
    call line( 38.0,  53.0, 1)
    call line( 36.0,  55.0, 1)
    call line( 32.0,  55.0, 1)
    call line( 28.5,  51.0, 1)    

    call line(  0.0,   0.0, 0)
    call line( -6.5,   0.0, 1)
    call line(-10.0,   3.0, 1)
    call line(-15.0,   7.0, 1)
    call line(-22.0,  14.0, 1)
    call line(-28.5,  25.0, 1)
    call line(-31.0,  26.0, 1)
    call line(-35.0,  34.0, 1)
    call line(-38.0,  44.0, 1)
    call line(-38.0,  53.0, 1)
    call line(-36.0,  55.0, 1)
    call line(-32.0,  55.0, 1)
    call line(-28.5,  51.0, 1)    

    call line( 34.0,  55.0, 0)
    call line( 34.0,  76.0, 1)
    call line( 31.0,  82.0, 1)
    call line( 26.0,  87.0, 1)
    call line( 21.0,  91.0, 1)
    call line( 15.0,  95.0, 1)
    call line(  0.0,  95.0, 1)    

    call line(-34.0,  55.0, 0)
    call line(-34.0,  76.0, 1)
    call line(-31.0,  82.0, 1)
    call line(-26.0,  87.0, 1)
    call line(-21.0,  91.0, 1)
    call line(-15.0,  95.0, 1)
    call line(  0.0,  95.0, 1)    

    ! nose
    call line( -5.0, 41.0, 0)
    call line( -4.0, 40.0, 1)
    call line(  0.0, 40.0, 1)
    call line(  2.0, 42.0, 1)
    call line(  3.0, 42.0, 1)
    call line(  5.5, 37.0, 1)
    call line(  5.0, 37.0, 1)
    call line(  4.0, 38.5, 1)
    call line(  0.5, 38.5, 1)
    call line(  0.0, 37.0, 1)
    call line( -2.0, 37.0, 1)
    call line( -3.0, 38.5, 1)
    call line( -7.0, 38.5, 1)
    call line( -8.0, 37.0, 1)
    call line( -8.5, 40.0, 1)
    call line( -4.0, 45.0, 1)
    call line( -4.0, 54.0, 1)
    call line( -5.0, 55.0, 1)    

    call line( -6.0, 53.0, 0)
    call line( -5.0, 53.0, 1)
    call line( -5.0, 47.0, 1)
    call line( -7.5, 46.0, 1)
    call line( -6.0, 53.0, 1)    

    ! left eye
    call line(-24.0, 55.0, 0)
    call line(-22.0, 53.0, 1)
    call line(-17.0, 54.5, 1)
    call line( -8.0, 55.0, 1)
    call line( -7.0, 55.5, 1)
    call line( -8.5, 56.5, 1)
    call line(-24.0, 55.0, 1)    

    call line( -8.0, 54.5, 0)
    call line(-12.0, 52.5, 1)    

    call line(-23.0, 56.0, 0)
    call line(-21.5, 57.0, 1)
    call line(-10.0, 58.0, 1)
    call line( -9.0, 57.0, 1)    

    ! left eyebrow
    call line(-27.5, 56.5, 0)
    call line(-24.0, 59.0, 1)
    call line(-11.0, 59.5, 1)
    call line( -7.0, 61.0, 1)
    call line( -4.0, 65.0, 1)
    call line( -9.0, 63.0, 1)
    call line(-25.0, 62.0, 1)
    call line(-27.5, 56.5, 1)    

    ! right eyebrow
    call line( 27.5, 56.5, 0)
    call line( 24.0, 59.0, 1)
    call line( 11.0, 59.5, 1)
    call line(  7.0, 61.0, 1)
    call line(  4.0, 65.0, 1)
    call line(  9.0, 63.0, 1)
    call line( 25.0, 62.0, 1)
    call line( 27.5, 56.5, 1)    

    ! right eye
    call line( 19.0, 53.0, 0)
    call line( 23.0, 55.0, 1)
    call line( 16.0, 55.0, 1)
    call line(  9.0, 56.0, 1)
    call line(  9.5, 55.0, 1)
    call line( 19.0, 53.0, 1)    

    call line(  9.0, 58.0, 0)
    call line( 12.0, 58.0, 1)
    call line( 19.0, 56.0, 1)
    call line( 21.5, 56.0, 1)    

    call line(  0.0, 29.0, 0)
    call line(  5.0, 29.0, 1)
    call line( 11.0, 27.0, 1)
    call line(  6.0, 32.0, 1)
    call line(  0.0, 30.0, 1)
    call line( -6.0, 32.0, 1)
    call line(-11.0, 27.0, 1)
    call line( -5.0, 29.0, 1)
    call line(  0.0, 29.0, 1)    

    call line(-6.5, 21.5, 0)
    call line(-3.5, 20.0, 1)
    call line( 3.5, 20.0, 1)
    call line( 6.5, 21.5, 1)
    call line(-5.0, 21.0, 0)
    call line( 5.0, 21.0, 1)
    read *
    call Xflush()
    call Xclose()
end program shonben

蔓延防止法ならぬションベン防止法も必要!

ウホッ!!いい男たち~ヤマジュン・パーフェクト

ウホッ!!いい男たち~ヤマジュン・パーフェクト

  • 作者:山川 純一
  • 発売日: 2003/11/01
  • メディア: コミック

【オトナのぬりえ】やらないか!

【オトナのぬりえ】やらないか!

  • 発売日: 2015/12/09
  • メディア: 単行本