summaryrefslogtreecommitdiff
path: root/graphics/circuit_macros/dpictools.pic
diff options
context:
space:
mode:
authorNorbert Preining <norbert@preining.info>2019-09-02 13:46:59 +0900
committerNorbert Preining <norbert@preining.info>2019-09-02 13:46:59 +0900
commite0c6872cf40896c7be36b11dcc744620f10adf1d (patch)
tree60335e10d2f4354b0674ec22d7b53f0f8abee672 /graphics/circuit_macros/dpictools.pic
Initial commit
Diffstat (limited to 'graphics/circuit_macros/dpictools.pic')
-rw-r--r--graphics/circuit_macros/dpictools.pic385
1 files changed, 385 insertions, 0 deletions
diff --git a/graphics/circuit_macros/dpictools.pic b/graphics/circuit_macros/dpictools.pic
new file mode 100644
index 0000000000..00c7c71c15
--- /dev/null
+++ b/graphics/circuit_macros/dpictools.pic
@@ -0,0 +1,385 @@
+# dpictools.pic
+# General-purpose pic macros. Input this file using the m4 macro NeedDpicTools
+# or the pic statement copy "HOMELIB_/dpictools.pic" when HOMELIB_ is defined
+# or, generically, copy "<path>dpictools.pic"
+
+# Circuit_macros Version 9.0, copyright (c) 2019 J. D. Aplevich under #
+# the LaTeX Project Public License. The files of this distribution may #
+# be redistributed or modified provided that this copyright notice is #
+# included and provided that modifications are clearly marked to #
+# distinguish them from this distribution. There is no warranty #
+# whatsoever for these files. #
+
+# findroot(function,left bound,right bound,tolerance,var name)
+# Solve function(x)=0 by the method of bisection
+# e.g. define parabola { $2 = ($1)^2 - 1 }
+# findroot( parabola, 0, 2, 1e-8, x )
+define findroot {$5 = 0; [ x_m = $2; x_M = $3
+ loop( $1(x_m,f_m);, abs(x_M-x_m)>$4,,
+ x_c = (x_m+x_M)/2
+ $1(x_c,f_c)
+ if sign(f_c)==sign(f_m) then {x_m=x_c} else {x_M=x_c};)
+ $5 := (x_m+x_M)/2 ] ; }
+
+# bisect(function,left bound,right bound, tolerance, var name)
+# Like findroot but uses recursion and without a [] box
+define bisect { x_m_$1 = $2; x_M_$1 = $3
+ x_c_$1 = (x_m_$1+x_M_$1)/2
+ if (abs(x_m_$1-x_M_$1) <= $4) then { $5 = x_c_$1 } else {
+ $1(x_m_$1,f_m_$1)
+ $1(x_c_$1,f_c_$1)
+ if (sign(f_c_$1)==sign(f_m_$1)) then { bisect($1,x_c_$1,x_M_$1,$4,$5) } \
+ else { bisect($1,x_m_$1,x_c_$1,$4,$5) } } }
+
+# case(i, alt1, alt2, ... ),
+# Case statement: execute alternative i
+# e.g., case(2, x=5, x=10, x=15) sets x to 10
+define case { exec sprintf("$%g",floor($1+0.5)+1); }
+
+# testexpr(i, expr1, expr2, ... )
+# Set i to index of the first true alternative
+# in a sequence of logical expressions, e.g.,
+# testexpr(i, 1>2, 1<2 ) sets i to 2; to 0
+# if no test is true.
+define testexpr { $1 = 0; [for i_testexpr=2 to $+ do {
+ exec sprintf("if $%g then {$1 := i_testexpr-1; i_testexpr=$+}",i_testexpr)
+ }] ; }
+
+# loop(initial,test,loopend,statements)
+# C-like loop. Commas in arg3 and arg4 must
+# be in quotes or parentheses, e.g.,
+# loop(i=1, i<=3, i+=1, print i) prints 1, 2, 3
+ld__ = 0
+define loop {ld__+=1
+ $1
+ for lx__[ld__]=0 to 1 do {
+ if $2 then { lx__[ld__]=0; $4; $3; } else { lx__[ld__]=1 }}
+ ld__-=1; }
+
+# array(var,expr1,expr2,...)
+# var[1]=expr1; var[2]=expr2,...
+define array {
+ for i_array=2 to $+ do { exec sprintf("$1[%g] = $%g",i_array-1,i_array); }}
+
+# posarray(Var,position1,position2,...)
+# Var[1]:position1; Var[2]:Position2,...
+define posarray {
+ for i_array=2 to $+ do { exec sprintf("$1[%g] : $%g",i_array-1,i_array); }}
+
+# slantbox(wid,ht,xslant,yslant,attributes)
+define slantbox { [
+ if "$1"=="" then { w = boxwid } else { w = $1 }
+ if "$2"=="" then { h = boxht } else { h = $2 }
+ if "$3"=="" then { xs = 0 } else { xs = $3 }
+ if "$4"=="" then { ys = 0 } else { ys = $4 }
+ NE: (w+xs,h+ys)/2 ; SE: (w-xs,-h+ys)/2
+ SW: (-w-xs,-h-ys)/2 ; NW: (-w+xs,h-ys)/2
+ N: 0.5 between NW and NE ; E: 0.5 between NE and SE
+ S: 0.5 between SE and SW ; W: 0.5 between SW and NW
+ C: 0.5 between SW and NE
+ line $5 from N to NE then to SE then to SW then to NW then to N
+ ] }
+# arraymax( data array, n, index name, value)
+# Find the index in array[1:n] of the first
+# occurrence of the max value. The value is
+# assigned if arg4 is non-blank. eg.,
+# array(x,4,9,8,6); arraymax( x,4,i )
+# assigns 2 to i, and arraymax( x,4,i,m )
+# assigns 2 to i and 9 to m
+define arraymax { { $3 = -1; if "$4" != "" then { $4 = 0 }; m_arrm = -1e25
+ for i_arrm=1 to $2 do { if $1[i_arrm] > m_arrm then {
+ $3 := i_arrm; m_arrm = $1[i_arrm] }}
+ if "$4" != "" then { $4 := m_arrm } } }
+
+# arraymin( data array, n, index name, value)
+# Like arraymax
+define arraymin { { $3 = -1; if "$4" != "" then { $4 = 0 }; m_arrm = 1e25
+ for i_arrm=1 to $2 do { if $1[i_arrm] < m_arrm then {
+ $3 := i_arrm; m_arrm = $1[i_arrm] }}
+ if "$4" != "" then { $4 := m_arrm } } }
+
+# copythru(macro_name,"datafile")
+# See the GNU pic manual
+# Implements "copy datafile thru macro_name"
+# for data separated by comma, spaces, or tabs
+define copythru {
+ sh "sed -e 's/^[ ]*/$1(/' -e 's/[ ]*$/)/' -e 's/[, ][ ]*/,/g' $2 \
+ > copy_tmp__"
+ copy "copy_tmp__"
+ sh "rm -f copy_tmp__";}
+
+# randn(array_name,n,mean,stddev)
+# Assign n Gaussian random numbers
+# in array_name[1] ... array_name[n]
+define randn {
+ if "$2"=="" then { n_randn = 1 } else { n_randn = $2 }
+ if "$3"=="" then { m_randn = 0 } else { m_randn = $3 }
+ if "$4"=="" then { s_randn = 1 } else { s_randn = $4 }
+ for i_randn=1 to n_randn by 2 do {
+ loop( t_randn=2, t_randn >= 1, u_randn = 2*rand()-1; v_randn = 2*rand()-1
+ t_randn = u_randn^2+v_randn^2 )
+ t_randn = sqrt( -2*loge(t_randn)/t_randn )
+ $1[i_randn] = u_randn*t_randn*s_randn+m_randn
+ if i_randn < n_randn then {
+ $1[i_randn+1] = v_randn*t_randn*s_randn+m_randn }
+ }
+ }
+
+# dfitpoints(V,n,m,P,mP)
+# Compute the controls in P[mP], P[mP+1]... for
+# the spline passing throught points V[m]...V[n]
+define dfitpoints {
+ if "$3"=="" then { m_dfit=0 } else { m_dfit=$3 }
+ if "$5"=="" then { mP_dfit=0 } else { mP_dfit=$5 }
+ n_dfit = $2; np_dfit = n_dfit-m_dfit
+ $4[mP_dfit]: $1[m_dfit]
+ for i_dfit=m_dfit+1 to n_dfit-1 do {
+ $4[mP_dfit+i_dfit-m_dfit]: $1[i_dfit]*(4/3) }
+ $4[mP_dfit+np_dfit]: $1[n_dfit]
+ $4[mP_dfit+1]: $4[mP_dfit+1]-$4[mP_dfit+0]/6 # forward substitution
+ d_dfit[1] = 1
+ for i_dfit = 2 to np_dfit-1 do { $4[mP_dfit+i_dfit]: \
+ $4[mP_dfit+i_dfit]-$4[mP_dfit+i_dfit-1]/d_dfit[i_dfit-1]/6
+ d_dfit[i_dfit] = 1-1/d_dfit[i_dfit-1]/36 }
+ for i_dfit= np_dfit-1 to 1 by -1 do { # backward substitution
+ $4[mP_dfit+i_dfit]: \
+ ($4[mP_dfit+i_dfit]-$4[mP_dfit+i_dfit+1]/6)/d_dfit[i_dfit] } }
+
+# dfitcurve(V,n,linetype,m (default 0))
+# Draw a spline through V[m],...V[n]
+# linetype=eg dotted. Works only with dpic.
+# The calculated control points P[i] satisfy
+# approximately:
+# P[0] = V[0]
+# P[i-1]/8 + P[i]*3/4 + P[i+1]/8 = V[i]
+# P[n] = V[n]
+# Like m4 macro fitcurve
+define dfitcurve { if "$4"=="" then { m_dfit=0 } else { m_dfit=$4 }
+ n_dfit = $2; np_dfit = n_dfit-m_dfit
+ M4P_[0]: $1[m_dfit]
+ case( min(max(np_dfit,-1),3)+1,
+ spline 0.551784 $3 from M4P_[0] to M4P_[0],
+ spline 0.551784 $3 from M4P_[0] to $1[n_dfit],
+ M4P_[3]: $1[n_dfit]; Q_dfit: (M4P_[3]-M4P_[0])/4
+ M4P_[1]: $1[m_dfit+1]-Q_dfit; M4P_[2]: $1[m_dfit+1]+Q_dfit
+ spline 0.551784 $3 from M4P_[0] to M4P_[1] then to M4P_[2] then to M4P_[3],
+ dfitpoints($1,$2,$4,M4P_,0) # draw using computed control points
+ spline 0.551784 $3 from M4P_[0] to 11/32 between M4P_[0] and M4P_[1] \
+ then to 5/32 between M4P_[1] and M4P_[2]
+ for i_dfit=2 to np_dfit-2 do { continue to M4P_[i_dfit] }
+ continue to 27/32 between M4P_[np_dfit-2] and M4P_[np_dfit-1] \
+ then to 21/32 between M4P_[np_dfit-1] and M4P_[np_dfit] \
+ then to M4P_[np_dfit]) }
+
+# histbins { data array name, n, [min], [max],
+# nbins, bin array name )
+# Generate the distribution of n values in
+# dataarray. If given, arg3 and arg4 specify
+# maximum and minimum data values, otherwise they
+# are calculated. Bins have index 0 to arg5-1
+define histbins { # dataarray, n, [min], [max], nbins, binarray
+{ if "$3" == "" then { arraymin($1,$2,mn_histb,n_histb)} else { n_histb = $3 }
+ if "$4" == "" then { arraymax($1,$2,mx_histb,m_histb)} else { m_histb = $4 }
+ f_histb = ($5-0.001)/(m_histb-n_histb)
+ for i_histb=0 to $5-1 do { $6[i_histb] = 0 }
+ for i_histb=1 to $2 do {
+ x_histb = floor(($1[i_histb]-n_histb)*f_histb)
+ if (x_histb >= 0) && (x_histb < $5) then { $6[x_histb] += 1 } }
+} }
+
+# dpquicksort(a,lo,hi,ix)
+# Given array a[lo:hi] and index
+# array ix[lo:hi] = lo,lo+1,lo+2,...hi,
+# sort a[lo:hi] and do identical exchanges on ix
+define dpquicksort { [ if $3 > $2 then {
+ pivot = $1[($2+($3))/2]
+ loop(lo = $2; hi = $3, lo <= hi,
+ loop(,$1[lo] < pivot, lo += 1 )
+ loop(,$1[hi] > pivot, hi -= 1 )
+ if lo < hi then {
+ tmp = $1[lo]; $1[lo] := $1[hi]; $1[hi] := tmp
+ tmp = $4[lo]; $4[lo] := $4[hi]; $4[hi] := tmp }
+ if lo <= hi then { lo += 1; hi -= 1 } )
+ if hi > $2 then { exec sprintf("dpquicksort($1,%g,%g,$4)",$2,hi) }
+ if lo < $3 then { exec sprintf("dpquicksort($1,%g,%g,$4)",lo,$3) }
+ } ] }
+
+# dprot(radians,x,y)
+# Evaluates to a rotated pair (like m4 rot_ )
+define dprot { cos($1)*($2)-sin($1)*($3),sin($1)*($2)+cos($1)*($3) }
+
+# rgbtohsv(r,g,b,h,s,v)
+# rgb color triple to hsv with h range 0 to 360
+define rgbtohsv { $4 = 0; $5 = 0; $6 = 0
+ [r = $1; g = $2; b = $3
+ maxc = max(max(r,g),b)
+ minc = min(min(r,g),b)
+ if maxc==minc then { $4 := 0 } \
+ else {if maxc == r then {
+ $4 := pmod(60*((g-b)/(maxc-minc)),360) } \
+ else {if maxc == g then {
+ $4 := 60*((b-r)/(maxc-minc)) + 120 } \
+ else { $4 := 60*((r-g)/(maxc-minc)) + 240 }}}
+ if maxc == 0 then { $5 := 0 } else { $5 := 1 - (minc/maxc) }
+ $6 := maxc
+ ] }
+
+# hsvtorgb(h,s,v,r,g,b)
+# hsv color triple to rgb, h has range 0 to 360
+define hsvtorgb { $4 = 0; $5 = 0; $6 = 0
+ [h = pmod($1,360)/60; s = $2; v = $3
+ i = floor(h)
+ f = h-i
+ m = v*(1-s)
+ n = v*(1-s*f)
+ k = v*(1-s*(1-f))
+ case(i+1,
+ $4 := v; $5 := k; $6 := m,
+ $4 := n; $5 := v; $6 := m,
+ $4 := m; $5 := v; $6 := k,
+ $4 := m; $5 := n; $6 := v,
+ $4 := k; $5 := m; $6 := v,
+ $4 := v; $5 := m; $6 := n)
+ ] }
+
+# cmyktorgb(c,m,y,k,r,g,b)
+# cmyk colors in percent to rgb
+define cmyktorgb {
+ $5 = 1-min(1,($1+$4)/100)
+ $6 = 1-min(1,($2+$4)/100)
+ $7 = 1-min(1,($3+$4)/100)
+ }
+
+# rgbtocmyk(r,g,b,c,m,y,k)
+# rgb to cmyk colors out of 100
+define rgbtocmyk {
+ $7 = min(1-$1,min(1-$2,1-$3))*100
+ $4 = (1-$7-$1)/(1-$7)*100
+ $5 = (1-$7-$2)/(1-$7)*100
+ $6 = (1-$7-$3)/(1-$7)*100 }
+
+# DefineRGBColor(colorname,r,g,b)
+# Arguments are in the range 0 to 1
+# Define dpic macro colorname according to the
+# postprocessor specified by dpic command-line
+# option; colorname then evaluates to a string
+define DefineRGBColor {
+case(dpicopt, # The order of the following is defined in dpic source:
+# MFpic:
+ command sprintf("\mfpdefinecolor{_$1__}{rgb}{%g,%g,%g}",$2,$3,$4)
+ define $1 {"_$1__"} ,
+# Mpost:
+ define $1 {sprintf("(%g,%g,%g)",$2,$3,$4)} ,
+# PDF:
+ define $1 {sprintf("%g %g %g",$2,$3,$4)} ,
+# PGF:
+ command sprintf("\definecolor{_$1__}{rgb}{%g,%g,%g}",$2,$3,$4)
+ define $1 {"_$1__"} ,
+# Pict2e:
+ command sprintf("\definecolor{_$1__}{rgb}{%g,%g,%g}",$2,$3,$4)
+ define $1 {"_$1__"} ,
+# PS:
+ define $1 {sprintf("%g %g %g",$2,$3,$4)} ,
+# PSfrag:
+ define $1 {sprintf("%g %g %g",$2,$3,$4)} ,
+# PSTricks:
+ command sprintf("\definecolor{_$1__}{rgb}{%g,%g,%g}",$2,$3,$4)
+ define $1 {"_$1__"} ,
+# SVG:
+ define $1 {sprintf("rgb(%g,%g,%g)",int($2*255),int($3*255),int($4*255))} ,
+# TeX:
+ command sprintf("\definecolor{_$1__}{rgb}{%g,%g,%g}",$2,$3,$4)
+ define $1 {"_$1__"} ,
+# tTeX:
+ command sprintf("\definecolor{_$1__}{rgb}{%g,%g,%g}",$2,$3,$4)
+ define $1 {"_$1__"} ,
+# xfig:
+ define $1 {"black"}
+ ) }
+
+# DefineHSVColor(colorname,h,s,v)
+# Like DefineRGBColor but takes arguments
+# h in [0,360], s in [0,1], and v in [0,1]
+define DefineHSVColor { hsvtorgb($2,$3,$4,r_HSVRGB,g_HSVRGB,b_HSVRGB)
+ DefineRGBColor($1,r_HSVRGB,g_HSVRGB,b_HSVRGB) }
+
+# DefineCMYKColor(colorname,c,m,y,k)
+# Like DefineRGBColor but arguments in percent
+define DefineCMYKColor { cmyktorgb($2,$3,$4,r_CMYKRGB,g_CMYKRGB,b_CMYKRGB)
+ DefineRGBColor($1,r_CMYKRGB,g_CMYKRGB,b_CMYKRGB) }
+
+# ShadeObject(DrawRoutineName, n, colorseq)
+# colorseq = 0,r0,g0,b0,
+# frac1,r1,g1,b1,
+# frac2,r2,g2,b2,
+# ...
+# 1,rn,gn,bn
+# with 0 < frac1 < frac2 < ... < 1
+#
+# calls DrawRoutineName(frac,r,g,b)
+# n+1 times for frac = 0, 1/n, 2/n, ... 1
+# with rgb args interpolated (in hsv space)
+# between colorseq points
+#
+# eg B: box; define HorizShade { line right B.wid thick B.ht/100/(1bp__) \
+# from (0,-($1)*B.ht) outlined rgbstring($2,$3,$4) }
+# ShadeObject(HorizShade, 100, 0,1,0,0, 1,0,0,1) at B
+#
+define ShadeObject { [ Origin: Here; nSteps = abs($2)
+ nextP = $3; nextR = $4; nextG = $5; nextB = $6
+ nextarg = 7
+ thisP = nextP
+# Creates [] wid 0 ht 0 at (0,0):
+ if $2 < 0 then { rgbtohsv(nextR,nextG,nextB,nextH,nextS,nextV) } \
+ else { rgbtohsv(nextR^2,nextG^2,nextB^2,nextH,nextS,nextV) }
+ if nextP*nSteps >= 1 then { nextP = 0 }
+ $1(nextP,nextR,nextG,nextB)
+ for stepnum = 1 to nSteps do {
+ if stepnum > nextP*nSteps then {
+ thisP = nextP; thisH = nextH; thisS = nextS; thisV = nextV
+ exec sprintf("nextP = $%g; nextR = $%g; nextG = $%g; nextB = $%g",\
+ nextarg,nextarg+1,nextarg+2,nextarg+3);
+ nextarg +=4 }
+ if nextP != thisP then {
+ rgbtohsv(nextR^2,nextG^2,nextB^2,nextH,nextS,nextV)
+ if thisS == 0 then { thisH = nextH }
+ if nextS == 0 then { nextH = thisH }
+ if thisH-nextH > 180 then { nextH += 360 } \
+ else { if nextH-thisH > 180 then { thisH +=360 } } }
+ if nextP > thisP then {
+ x = (stepnum/nSteps-thisP)/(nextP-thisP)
+ currP = thisP*(1-x) + nextP*x
+ currH = thisH*(1-x) + nextH*x
+ currS = thisS*(1-x) + nextS*x
+ currV = thisV*(1-x) + nextV*x
+ hsvtorgb(currH,currS,currV,cRsq,cGsq,cBsq)
+ if $2 < 0 then { $1(currP,cRsq,cGsq,cBsq) } \
+ else { $1(currP,sqrt(cRsq),sqrt(cGsq),sqrt(cBsq)) } }
+ }
+ exec sprintf("$%g",nextarg)
+ ] }
+
+# Useful for debugging:
+# Print Pos:(Pos.x,Pos.y)
+define prpos { { print sprintf("$1:(%g,%g)",($1).x,($1).y) } }
+
+define prval { print sprintf("$1=%g",$1) }
+define prval2 { print sprintf("$1=%g, $2=%g",$1,$2) }
+define prval3 { print sprintf("$1=%g, $2=%g, $3=%g",$1,$2,$3) }
+
+# prow(array name,lo,hi)
+# print array[lo:hi] as a row
+# eg array(x,6,4,5); prow(x,1,3)
+define prow {
+ sh "echo -n \"print \\"\" > $1_xxx"
+ for i=$2 to $3-1 do { sh sprintf("echo -n \"%g \" >> $1_xxx",$1[i]) }
+ sh sprintf("echo \"%g\\"\" >> $1_xxx",$1[$3])
+ copy "$1_xxx"
+ sh "rm $1_xxx"
+ }
+
+define rnd {int($1+sign($1)/2)} # round function
+
+# print " *** dpic: dpictools.pic processed"
+define dpictools {1}
+# dpictools end