From e0c6872cf40896c7be36b11dcc744620f10adf1d Mon Sep 17 00:00:00 2001 From: Norbert Preining Date: Mon, 2 Sep 2019 13:46:59 +0900 Subject: Initial commit --- graphics/circuit_macros/dpictools.pic | 385 ++++++++++++++++++++++++++++++++++ 1 file changed, 385 insertions(+) create mode 100644 graphics/circuit_macros/dpictools.pic (limited to 'graphics/circuit_macros/dpictools.pic') 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 "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 -- cgit v1.2.3