!------------------------------------------------- ! SGpack Module !------------------------------------------------- module sgpack use dcl_common contains !--------------------------------------------------------- subroutine DclPrintDeviceList() !ワークステーション名のリスト call sgpwsn() end subroutine !------------------------------------------------------------------------ !正規化変換 !--------------------------------- subroutine DclTransShortToLong(cts,ctl) !略称から名称を求める. character(len=*), intent(in) :: cts character(len=*), intent(out) :: ctl call sgtrsl(cts,ctl) end subroutine !--------------------------------- subroutine DclTransShortToNum(cts,ntx) !略称から変換関数番号を求める. character(len=*), intent(in) :: cts integer, intent(out) :: ntx call sgtrsn(cts,ntx) end subroutine !--------------------------------- subroutine DclTransLongToShort(ctl,cts) !名称から略称を求める. character(len=*), intent(in) :: ctl character(len=*), intent(out) :: cts call sgtrls(ctl,cts) end subroutine !--------------------------------- subroutine DclTransLongToNum(ctl,ntx) !名称から変換関数番号を求める. character(len=*), intent(in) :: ctl integer, intent(out) :: ntx call sgtrln(ctl,ntx) end subroutine !--------------------------------- subroutine DclTransNumToShort(ntx,cts) !変換関数番号から略称を求める. integer, intent(in) :: ntx character(len=*), intent(out) :: cts call sgtrns(ntx,cts) end subroutine !--------------------------------- subroutine DclTransNumToLong(ntx,ctl) !変換関数番号から名称を求める. integer, intent(in) :: ntx character(len=*), intent(out) :: ctl call sgtrnl(ntx,ctl) end subroutine !--------------------------------- subroutine DclGetViewPort(xmin, xmax, ymin, ymax) real, intent(out), optional :: xmin, xmax, ymin, ymax !ビューポート call sgqvpt(xmin0, xmax0, ymin0, ymax0) if(present(xmin)) xmin = xmin0 if(present(xmax)) xmax = xmax0 if(present(ymin)) ymin = ymin0 if(present(ymax)) ymax = ymax0 end subroutine !--------------------------------- subroutine DclGetWindow(xmin, xmax, ymin, ymax) real, intent(out), optional :: xmin, xmax, ymin, ymax !ウインドウ call sgqwnd(xmin0, xmax0, ymin0, ymax0) if(present(xmin)) xmin = xmin0 if(present(xmax)) xmax = xmax0 if(present(ymin)) ymin = ymin0 if(present(ymax)) ymax = ymax0 end subroutine !--------------------------------- subroutine DclGetSimilarity(factor, xoffset, yoffset) real, intent(out), optional :: factor, xoffset, yoffset call sgqsim(factor0, xoff0, yoff0) if(present(factor)) factor = factor0 if(present(xoffset)) xoffset = xoff0 if(present(yoffset)) yoffset = yoff0 end subroutine !--------------------------------- subroutine DclGetMapProjectionAngle(longitude,latitude,rotation) real, intent(out), optional :: longitude,latitude,rotation real :: lon, lat, rot call sgqmpl(lon, lat, rot) if(present(longitude)) longitude = lon if(present(latitude )) latitude = lat if(present(rotation )) rotation = rot end subroutine !--------------------------------- function DclGetTransNumber() integer :: DclGetTransNumber !変換関数番号 call sgqtrn(DclGetTransNumber) end function !------------------------------------------------------------------------ !ポリラインプリミティブ !--------------------------------- subroutine DclDrawLine (x,y,type,index) !折れ線を描く. real, intent(in), dimension(:) :: x, y integer, intent(in), optional :: type, index integer :: type0, index0 if(present(type)) then type0 = type else call sgqplt(type0) end if if(present(index)) then index0 = index else call sgqpli(index0) end if nx = size(x) ny = size(y) if(nx.ne.ny) call msgdmp('M', 'DclDrawLine', 'Length of x and y don''t match.') n = min(nx, ny) call sgplzu(n,x,y,type0,index0) end subroutine !--------------------------------- subroutine DclDrawLineNormalized(x, y, type, index) real, intent(in), dimension(:) :: x, y integer, intent(in), optional :: type, index integer :: type0, index0 if(present(type)) then type0 = type else call sgqplt(type0) end if if(present(index)) then index0 = index else call sgqpli(index0) end if nx = size(x) ny = size(y) if(nx.ne.ny) call msgdmp('M', 'DclDrawLineNormalized', & & 'Length of x and y don''t match.') n = min(nx, ny) call sgplzv(n, x, y, itype0, index0) end subroutine !--------------------------------- subroutine DclDrawLineProjected(x,y,type,index) real, intent(in), dimension(:) :: x, y integer, intent(in), optional :: type, index integer :: type0, index0 if(present(type)) then type0 = type else call sgqplt(type0) end if if(present(index)) then index0 = index else call sgqpli(index0) end if nx = size(x) ny = size(y) if(nx.ne.ny) call msgdmp('M', 'DclDrawLineProjected', & & 'Length of x and y don''t match.') n = min(nx, ny) call sgplzr(n, x, y, itype0, index0) end subroutine !--------------------------------- subroutine DclSetLineType(type) !ラインタイプを設定する. integer, intent(in) :: type !線種 call sgsplt(type) end subroutine !--------------------------------- subroutine DclSetLineIndex(index) !ラインインデクスの設定. integer, intent(in) :: index !ラインインデクス call sgspli(index) end subroutine !--------------------------------- subroutine DclSetLineText(text) !ラベルの文字列設定. character(len=*), intent(in) :: text !描く文字列(初期値は'A') call sgsplc(text) end subroutine !--------------------------------- subroutine DclSetLineTextSize(height) !ラベルの文字高設定 real, intent(in) :: height !文字列の高さ call sgspls(height) end subroutine !--------------------------------- subroutine DclNextLineText() !ラベルの最後の文字番号を増やす. call sgnplc() end subroutine !--------------------------------- function DclGetLineType() integer :: DclGetLineType call sgqplt(DclGetLineType) end function !--------------------------------- function DclGetLineIndex() integer :: DclGetLineIndex call sgqpli(DclGetLineIndex) end function !--------------------------------- subroutine DclGetLineText(text) character(len=*), intent(out) :: text !描く文字列(初期値は'A') call sgqplc(text) end subroutine !--------------------------------- function DclGetLineTextSize() real :: DclGetLineTextSize call sgqpls(DclGetLineTextSize) end function !------------------------------------------------------------------------------ ! ポリマーカープリミティブ !--------------------------------- subroutine DclDrawMarker(x,y,type,index,height) real, intent(in), dimension(:) :: x, y integer, intent(in), optional :: type, index real, intent(in), optional :: height integer :: type0, index0 real :: height0 nx = size(x) ny = size(y) if(nx.ne.ny) call msgdmp('M', 'DclDrawMarker', 'Length of x and y don''t match.') n = min(nx, ny) if(present(type) ) then type0 = type else call sgqpmt(type0) end if if(present(index) ) then index0 = index else call sgqpmi(index0) end if if(present(height)) then height0 = height else call sgqpms(height0) end if call sgpmzu(n,x,y,type0,index0, height0) end subroutine !--------------------------------- subroutine DclDrawMarkerNormalized(x, y, type, index, height) real, intent(in), dimension(:) :: x, y integer, intent(in), optional :: type, index real, intent(in), optional :: height integer :: type0, index0 real :: height0 nx = size(x) ny = size(y) if(nx.ne.ny) call msgdmp('M', 'DclDrawMarkerNormalized', & & 'Length of x and y don''t match.') n = min(nx, ny) if(present(type) ) then type0 = type else call sgqpmt(type0) end if if(present(index) ) then index0 = index else call sgqpmi(index0) end if if(present(height)) then height0 = height else call sgqpms(height0) end if call sgpmzv(n,x,y,type0,index0, height0) end subroutine !--------------------------------- subroutine DclDrawMarkerProjected(x, y, type, index, height) real, intent(in), dimension(:) :: x, y integer, intent(in), optional :: type, index real, intent(in), optional :: height integer :: type0, index0 real :: height0 nx = size(x) ny = size(y) if(nx.ne.ny) call msgdmp('M', 'DclDrawMarkerProjected', & & 'Length of x and y don''t match.') n = min(nx, ny) if(present(type) ) then type0 = type else call sgqpmt(type0) end if if(present(index) ) then index0 = index else call sgqpmi(index0) end if if(present(height)) then height0 = height else call sgqpms(height0) end if call sgpmzr(n,x,y,type0,index0, height0) end subroutine !--------------------------------- subroutine DclSetMarkerType(type) !マーカータイプの設定. integer, intent(in) :: type !マーカータイプ call sgspmt(itype) end subroutine !--------------------------------- subroutine DclSetMarkerIndex(index) !マーカーのラインインデクスの設定 integer, intent(in) :: index !ラインインデクス call sgspmi(index) end subroutine !--------------------------------- subroutine DclSetMarkerSize(height) !マーカーの大きさ設定. real, intent(in) :: height !マーカーの大きさ call sgspms(height) end subroutine !--------------------------------- function DclGetMarkerType() integer :: DclGetMarkerType !マーカータイプ call sgqpmt(DclGetMarkerType) end function !--------------------------------- function DclGetMarkerIndex() integer :: DclGetMarkerIndex !ラインインデクス call sgqpmi(DclGetMarkerIndex) end function !--------------------------------- function DclGetMarkerSize() real :: DclGetMarkerSize !マーカーの大きさ call sgqpms(DclGetMarkerSize) end function !------------------------------------------------------------------ ! テキスト !--------------------------------- subroutine DclDrawText(x, y, text, height, angle, centering, index) real, intent(in) :: x, y !文字の位置 character(len=*), intent(in) :: text !文字列 real, intent(in) :: height, angle !文字の高さ integer, intent(in) :: centering,index optional :: height, angle, centering,index real :: height0 integer :: angle0, cent0, index0 if(present(height)) then height0 = height else call sgqtxs(height0) end if if(present(angle) ) then angle0 = nint(angle) else call sgqtxr(angle0) end if if(present(centering)) then cent0 = centering else call sgqtxc(cent0) end if if(present(index) ) then index0 = index else call sgqtxi(index0) end if call sgtxzu(x,y,text,height0,angle0,cent0,index0) end subroutine !--------------------------------- subroutine DclDrawTextNormalized(x, y, text, height, angle, centering, index) real, intent(in) :: x, y !文字の位置 character(len=*), intent(in) :: text !文字列 real, intent(in) :: height, angle !文字の高さ integer, intent(in) :: centering,index optional :: height, angle, centering,index real :: height0 integer :: angle0, cent0, index0 if(present(height)) then height0 = height else call sgqtxs(height0) end if if(present(angle) ) then angle0 = nint(angle) else call sgqtxr(angle0) end if if(present(centering)) then cent0 = centering else call sgqtxc(cent0) end if if(present(index) ) then index0 = index else call sgqtxi(index0) end if call sgtxzv(x,y,text,height0,angle0,cent0,index0) end subroutine !--------------------------------- subroutine DclDrawTextProjected(x, y, text, height, angle, centering, index) real, intent(in) :: x, y !文字の位置 character(len=*), intent(in) :: text !文字列 real, intent(in) :: height, angle !文字の高さ integer, intent(in) :: centering,index optional :: height, angle, centering,index real :: height0 integer :: angle0, cent0, index0 if(present(height)) then height0 = height else call sgqtxs(height0) end if if(present(angle) ) then angle0 = nint(angle) else call sgqtxr(angle0) end if if(present(centering)) then cent0 = centering else call sgqtxc(cent0) end if if(present(index) ) then index0 = index else call sgqtxi(index0) end if call sgtxzr(x,y,text,height0,angle0,cent0,index0) end subroutine !--------------------------------- subroutine DclSetTextHeight(height) !文字の高さ設定. real, intent(in) :: height !文字の高さ call sgstxs(height) end subroutine !--------------------------------- subroutine DclSetTextAngle(angle) !文字列の角度の設定. real, intent(in) :: angle !文字列の傾きを度の単位で与える call sgstxr(nint(angle)) end subroutine !--------------------------------- subroutine DclSetTextIndex(index) !文字列のラインインデクスの設定. integer, intent(in) :: index !ラインインデクス call sgstxi(index) end subroutine !--------------------------------- subroutine DclSetTextPosition(centering) !文字列のセンタリングオプション設定 integer, intent(in) :: centering !センタリングオプション call sgstxc(centering) end subroutine !--------------------------------- function DclGetTextHeight() real :: DclGetTextHeight !文字の高さ call sgqtxs(DclGetTextHeight) end function !--------------------------------- function DclGetTextAngle() real :: DclGetTextAngle !文字列の傾きを度の単位で与える call sgqtxr(irot) DclGetTextAngle = irot end function !--------------------------------- function DclGetTextIndex() integer :: DclGetTextIndex !ラインインデクス call sgqtxi(DclGetTextIndex) end function !--------------------------------- function DclGetTextPosition() integer :: DclGetTextPosition !センタリングオプション call sgqtxc(DclGetTextPosition) end function !------------------------------------------------------------- ! トーンプリミティブ !--------------------------------- subroutine DclDrawHatch(x, y, pattern) !u 座標系で多角形領域の塗りつぶし. real, intent(in), dimension(:) :: x,y integer, intent(in), optional :: pattern nx = size(x) ny = size(y) if(nx.ne.ny) call msgdmp('M', 'DclDrawHatch', & & 'Length of x and y don''t match.') n = min(nx, ny) if(present(pattern) ) then ipat0 = pattern else call sgqtnp(ipat0) end if call sgtnzu(n,x,y,itpat0) end subroutine !--------------------------------- subroutine DclDrawHatchNormalized(x, y, pattern) real, intent(in), dimension(:) :: x,y integer, intent(in), optional :: pattern nx = size(x) ny = size(y) if(nx.ne.ny) call msgdmp('M', 'DclDrawHatchNormalized', & & 'Length of x and y don''t match.') n = min(nx, ny) if(present(pattern) ) then ipat0 = pattern else call sgqtnp(ipat0) end if call sgtnzv(n,x,y,itpat0) end subroutine !--------------------------------- subroutine DclDrawHatchProjected(x, y, pattern) real, intent(in), dimension(:) :: x,y integer, intent(in), optional :: pattern nx = size(x) ny = size(y) if(nx.ne.ny) call msgdmp('M', 'DclDrawHatchProjected', & & 'Length of x and y don''t match.') n = min(nx, ny) if(present(pattern) ) then ipat0 = pattern else call sgqtnp(ipat0) end if call sgtnzr(n,x,y,itpat0) end subroutine !--------------------------------- subroutine DclSetHatchPattern(pattern) ! トーンパターン番号設定 integer, intent(in) :: pattern !トーンパターン番号 call sgstnp(pattern) end subroutine !--------------------------------- function DclGetHatchPattern() !現在設定されているトーンパターン番号参照 integer :: DclGetHatchPattern !現在設定されているトーンパターン番号 call sgqtnp(DclGetHatchPattern) end function !-------------------------------------------------------------------------------------- !ラインサブプリミティブ !------------------------------------------------------------------------- ! アローサブプリミティブ subroutine DclDrawArrow(x1,y1,x2,y2,type,index) real, intent(in) :: x1, y1, x2, y2 integer, intent(in), optional :: type, index integer :: type0 if(present(type) ) then type0 = type else call sgqlat(type0) end if if(present(index) ) then index0 = index else call sgqlai(index0) end if call sglazu(x1,y1,x2,y2,type0,index0) end subroutine !--------------------------------- subroutine DclDrawArrowNormalized(x1,y1,x2,y2,type,index) real, intent(in) :: x1, y1, x2, y2 integer, intent(in), optional :: type, index integer :: type0 if(present(type) ) then type0 = type else call sgqlat(type0) end if if(present(index) ) then index0 = index else call sgqlai(index0) end if call sglazv(x1,y1,x2,y2,type0,index0) end subroutine !--------------------------------- subroutine DclDrawArrowProjected(x1,y1,x2,y2,type,index) real, intent(in) :: x1, y1, x2, y2 integer, intent(in), optional :: type, index integer :: type0 if(present(type) ) then type0 = type else call sgqlat(type0) end if if(present(index) ) then index0 = index else call sgqlai(index0) end if call sglazr(x1,y1,x2,y2,type0,index0) end subroutine !--------------------------------- subroutine DclSetArrowLineType(type) !描く線分のラインタイプを設定する. integer, intent(in) :: type !線分のラインタイプ call sgslat(type) end subroutine !--------------------------------- subroutine DclSetArrowLineIndex(index) !描く線分の ラインインデクスを設定する integer, intent(in) :: index !線分のラインインデクス call sgslai(index) end subroutine !--------------------------------- function DclGetArrowLineType() !現在設定されているラインタイプ integer :: DclGetArrowLineType !線分のラインタイプ call sgqlat(DclGetArrowLineType) end function !--------------------------------- function DclGetArrowLineIndex() !現在設定されているラインインデクス integer :: DclGetArrowLineIndex !線分のラインインデクス call sgqlai(DclGetArrowLineIndex) end function !--------------------------------- end module