このディレクトリの索引
http://hibari.2ch.net/test/read.cgi/tech/1320365280/174
#  [1] 授業単元:文字列 
#  [2] 問題文(含コード&リンク): 
#  入力した時間と分を長針と短針で示す 
#  アナログ時計を作れ。 
#  

長針の長さ(200).
単身の長さ(140).
中心X座標(240).
中心Y座標(240).

アナログ時計(_時,_分) :-
        _時_1 is _時 mod 12,
        アナログ時計描画(_時_1,_分).

アナログ時計描画(_時,_分) :-
        時分をラジアン角度で表現する(_時,_分,_ラジアン角度_時,_ラジアン角度_分),        長針の長さ(_長針の長さ),
        短針の長さ(_短針の長さ),
        グラフィック描画(_中心X座標,_中心Y座標,_長針の長さ,_短針の長さ,_ラジアン角度_分,_ラジアン角度_時).

時分をラジアン角度で表現する(_時,_分,_ラジアン角度_時,_ラジアン角度_分) :-
        _ラジアン角度_時 is 2 * pi * ( 1 - _時 / 12) + pi / 2,
        _ラジアン角度_分 is 2 * pi * ( 1 - _分 / 60) + pi / 2.

グラフィック描画(_中心X座標,_中心Y座標,_長針の長さ,_短針の長さ,_長針の角度,_短針の角度) :-
        newpath,
        時計の円周装飾を描画(_中心X座標,_中心Y座標,_半径),
        長針の描画(_中心X座標,_中心Y座標,_長針の長さ,_長針の角度),
        短針の描画(_中心X座標,_中心Y座標,_短針の長さ,_短針の角度),
        showpage.

長針の描画(_中心X座標,_中心Y座標,_長針の長さ,_長針の角度) :-
        moveto(_中心X座標,_中心Y座標),
        X_1 is truncate(_長針の長さ * cos(_長針の角度)),
        Y_1 is truncate(_長針の長さ * sin(_長針の角度)),
        setlinewidth(3),
        rlineto(X_1,Y_1),
        stroke.

短針の描画(_中心X座標,_中心Y座標,_短針の長さ,_短針の角度) :-
        moveto(_中心X座標,_中心Y座標),
        X_2 is truncate(_短針の長さ * cos(_短針の角度)),
        Y_2 is truncate(_短針の長さ * sin(_短針の角度)),
        setlinewidth(3),
        rlineto(X_2,Y_2),
        stroke.

時計の円周装飾を描画(_中心X座標,_中心Y座標,_半径) :-
        setlinewidth(1),
        arc(_中心X座標,_中心Y座標,_半径,0,360),
        stroke.


%%%%%%%  ポストスクリプト述語  %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

pswr(G,X) :-
        pswr_2(G,X),!.
pswr(P) :-
        functor(P,F,A),
        pswr_1(1,A,P,L1,L2),
        (   L1=[],
                G0='';
                not(L1=[]),
                concat_atom(L1,' ',G0)
        ),
        concat_atom([G0,' ',F,'\n'],G1),
        pswr_2(G1,L2),!.
pswr_1(N,A,_,[],[]) :- N>A,!.
pswr_1(N,E,P,['%t'|R1],[X|R2]) :-
        arg(N,P,X),
        M is N+1,
        pswr_1(M,E,P,R1,R2).
pswr_2(G,L) :-
        telling(user),
        e_printf(G,L),!.
pswr_2(G,L)
  :-
        telling(screen),
        fopen('temp.ps','a+',F),
        sprintf(G,L,S),
        fputs(S,F),
        fclose(F),!.

pswr_2(G,L) :-
        write_formatted(G,L).

pstell(F) :-
        slush_op(F,F1),
        tell(F1),
        write('%!'),
        write('Adobe-PS'),nl,!.

arc(_中心X座標,_中心Y座標,_半径,_開始角度,_弧角度) :-
        _中心X座標の二 is _中心X座標,
        _中心Y座標の二 is _中心Y座標,
        stroke,
        pswr(arc(_中心X座標の二,_中心Y座標の二,_半径,_開始角度,_弧角度)),!.

save :-
        pswr(' /saveobj save def\n'),!.
restore :-
        pswr(' saveobj restore\n'),!.

stroke :-
        pswr(stroke),!.

closepath :-
        pswr(closepath),!.

setrgbcolor(Red,Green,Blue) :-
        pswr(setrgbcolor(Red,Green,Blue)),!.
sethsbcolor(Hue,Saturation,Brightness) :-
        pswr(sethsbcolor(Hue,Saturation,Brightness)),!.

setlinewidth(N) :-
        pswr(setlinewidth(N)),!.

rlineto(X,Y) :-
        X1 is X,
        Y1 is Y,
        pswr(rlineto(X1,Y1)),!.

lineto(X,Y) :-
        X1 is X,
        Y1 is Y,
        pswr(lineto(X1,Y1)),!.

curveto([]) :- !.
curveto([A|R]) :-
        not(list(A)),
        concat([A|R],' ',L),
        wr(' %t curveto\n',[L]),!.
curveto([[X1,Y1,X2,Y2,X3,Y3]|R]) :-
        curveto(X1,Y1,X2,Y2,X3,Y3),
        curveto(R),!.
curveto([[X1,Y1]|R]) :-
        flat([[X1,Y1]|R],L),
        curveto(L),!.
curveto(X1,Y1,X2,Y2,X3,Y3) :-
        pswr(curveto(X1,Y1,X2,Y2,X3,Y3)),!.

rcurveto([]) :- !.
rcurveto([A|R]) :-
        not(list(A)),
        concat([A|R],' ',L),
        wr(' %t rcurveto\n',[L]),!.
rcurveto([[X1,Y1,X2,Y2,X3,Y3]|R]) :-
        rcurveto(X1,Y1,X2,Y2,X3,Y3),
        rcurveto(R),!.
rcurveto([[X1,Y1]|R]) :-
        flat([[X1,Y1]|R],L),
        rcurveto(L),!.
rcurveto(X1,Y1,X2,Y2,X3,Y3) :-
        pswr(rcurveto(X1,Y1,X2,Y2,X3,Y3)),!.

setdash([],Y) :-
        pswr(setdash([],Y)),!.
setdash([A|R],Y) :-
        concat([A|R],' ',X0),
        concat(['[',X0,']'],X),
        pswr(setdash(X,Y)),!.
setdash(X,Y) :-
        pswr(setdash(X,Y)),!.
setlinecap(X) :-
        pswr(setlinecap(X)),!.
setlinejoin(X) :-
        pswr(setlinejoin(X)),!.
matrix :-
        pswr(matrix),!.

setmatrix(Matrix) :-
        flat(Matrix,FlatMatrix),
        concat(FlatMatrix,' ',X0),
        concat(['[',X0,']'],X),
        pswr(setdash(X,Y)),!.
setscreen(Frequency,Angle,Proc) :-
        pswr(setscreen(Frequency,Angle,Proc)),!.
stroke :-
        pswr(stroke),!.

moveto(X+X1,Y+Y1) :-
        var(X),
        var(Y),
        integer(X1),
        integer(Y1),
        pswr('currentpoint exch \n'),
        concat([X1,' add exch'],S),
        pswr(S),
        concat([Y1,' add moveto\n'],S2),
        pswr(S2),!.


moveto(X+X1,Y) :-
        var(X),
        integer(X1),
        var(Y),
        pswr('currentpoint exch \n'),
        concat([X1,' add exch moveto'],S),
        pswr(S),!.

moveto(X,Y+Y1) :-
        var(X),
        integer(Y1),
        var(Y),
        pswr('currentpoint \n'),
        concat([Y1,' add moveto'],S),
        pswr(S),!.

moveto(X,Y) :-
        var(X),
        Y1 is Y,
        pswr('currentpoint pop \n'),
        pswr(moveto(Y1)),!.

moveto(X,Y) :-
        var(Y),
        X1 is X,
        concat([X1,' exch moveto'],S),
        pswr('currentpoint exch pop \n'),
        pswr(S),!.

moveto(X,Y) :-
        X1 is X,
        Y1 is Y,
        pswr(moveto(X1,Y1)),!.
showpage :-
        pswr(showpage),!.

copypage :-
        pswr(copypage),!.

erasepage :-
        pswr(erasepage),!.

fill :-
        pswr(fill),!.


ps2pdf(FO) :-
        concat(['/usr/local/Adobe/Acrobat7.0/bin/acroread ',FO2],S),
        system(S),!.

newpath
  :-
        pswr(newpath),!.

xpos(Y)
  :-
        Y1 is Y,
        pswr('/xpos %d def\n',[Y1]),!.

ypos(Y) :-
        Y1 is Y,
        pswr('/ypos %d def\n',[Y1]),!.

image(_スキャン長,_スキャンライン数,_ビット数,_変換配列,_16進数ならび文字列) :-
        sprintf('[%t %t %t %t %t %t]',_変換配列,_変換配列文字列),
        sprintf(' %t %t %t %t {<%t>} image ',[_スキャン長,_スキャンライン数,_ビット数,_変換配列文字列,_16進数ならび文字列],S),
        pswr(S),!.

scale(X,Y) :-
        X1 is X,
        Y1 is Y,
        pswr(scale(X,Y)),!.

translate(X,Y) :-
        X1 is X,
        Y1 is Y,
        pswr(translate(X1,Y1)),!.

rotate(R) :-
        R1 is R,
        pswr(rotate(R1)),!.

p_point(X,Y) :-
        X1 is X,
        Y1 is Y,
        moveto(X1,Y1),
        rlineto(1,0),
        stroke,!.