'===========================================================================
' Subject: REDIM PRESERVE                    Date: 12-16-95 (16:53)       
' Author:  Jamshid Khoshrangi                Code: PB                     
' Origin:  qjackson@direct.ca              Packet: LIBRARY.ABC
'===========================================================================
'    REDIM.PBU                                           REDIM.PBU


'                    Universal REDIM PRESERVE v1.1
'                             (For PB 3.2)

'              Copyright 1995 by AhuraMazda(tm) Software

'                    Written by Jamshid Khoshrangi

'                Internet E-mail: qjackson@direct.ca

'    PURPOSE:

'    I dearly miss PDS/VBDOS's ability to redimension an array without
'    losing the array's previous contents.  This feature, called
'    REDIM PRESERVE, can be emulated, so I wrote a routine to emulate
'    REDIM PRESERVE a long time ago, but I soon found my code littered
'    with:

        REDIM.PRESERVE.STRING
        REDIM.PRESERVE.INTEGER
'            :
'            :
        REDIM.PRESERVE.LONG
        REDIM.PRESERVE.SINGLE

'    The staff at PowerBASIC Inc. have hinted that REDIM PRESERVE will
'    "most likely" be a feature of version 4.0, or something like that.
'    Meanwhile, I need a universal REDIM PRESERVE, and I need it now!
'    <grin>

'    I finally got around to writing a "universal" REDIM PRESERVE that
'    takes an array of any of the intrinsic PowerBASIC data types and
'    REDIM's it.

'    NOTES:
    
'    REDIM_PRESERVE works like this:

        $LINK "REDIM.PBU"

        DECLARE SUB REDIM_PRESERVE(ANY, INTEGER)

        REDIM_PRESERVE TheArray(), NewMax

'    TheArray() may be any of the following types:

        BYTE        WORD        DWORD       INTEGER
        LONG        QUAD        SINGLE      DOUBLE
        EXT         FIX         BCD         STRING (Dynamic only!)

'    Any other type, say an array of fixed length strings, will generate
'    run-time ERROR 73 (Feature unavailable).

'    WARNING:  TheArray() must be dynamic.  Passing a static array will
'    NOT generate an error, and the array will come back redimensioned
'    as a dynamic array BUT if you pass a static array to REDIM_PRESERVE,
'    memory will not be reclaimed.

'    How did I do it?  Magic!  The source file is about 500 lines long,
'    but, boy, does it do the job and do it fast -- and well.  And
'    all in native PB and a little inline assembler for good measure.

'    The PBU is freeware.  That is to say, I maintain my copyright, but
'    grant anyone and everyone the right to use the PBU in their code
'    as they see fit.  The source code, however, if it is purchased, may
'    not be distributed.

'    For the curious, the source code is available from AhuraMazda(tm)
'    Software for a $25 (Canadian Funds) money order payable to
'    "Quinn Tyler Jackson", sent to:

'        AhuraMazda(tm) Software,
'        P.O. Box 44072,
'        6518 East Hastings Street,
'        Burnaby, British Columbia
'        V5B 4Y2  CANADA

'    Remember to make the money order payable to Quinn Tyler Jackson,
'    or it will have to be returned to you, without the source code.  ;)

'    Jamshid "The Kludge" Khoshrangi


DEFINT A-Z:DIM SHARED K,S,B&,Z&:V1 'Created by PostIt! 7.2
SUB V1:OPEN "O",1,"PB_RDP11.ZIP",4^6:Z&=3879:?STRING$(50,177);
U"%up()%9%%%R-%5U&_DYG>AB1,.%%XE%%%.%%%%wj%inrS[ugzV2fN;#T^>#nNPM
U"L6nnBTDV4lT5nVZ+%D8rM8g#/c-J#?jsGcY^<9S%l=JRz1bm+xwQmIegS3JiBg2
U"T_Oo+x2SB/d[pn=mAIn#PGq*$0[;QaT*ov\r)$D:D4fkZ=SVmo4\oV36#l]?B?/
U"\Z/8pKluUBhQtnJ>uWt?<:)qgM97%a6N[a1L94x*$q2Fp?i97b'?tB'UnO0%o(Z
U"K05^Y^Xq\MT)InQ^oOM6M-yjTvDDcV+X\l)RiYJo8fPXcP'n%V45Cr1GY_O&^PV
U"%,'4igCGHY<\P=(%d4'aGw\f_#,FCSYHiX1TI7u'6;i4CaYiE;GRNa'3DR\alQ=
U"RFsaa]:Rra1hp,.]:o&aQ;ARSC;-^:[C5Cl/$14IH50$fQ,Q0lo^a,vaQE:R$G$
U")b,8Z[:(H'i#Cq?kY0aDGZ,62H?],'x$ps8F>Ip3n/:-c'M$4Us6dlh,v&dhl,v
U"e?g+3s>xee_unCG'rLOeem_2DGc'L+RERD?$Dlz(<2clz(t\CGNna[BGW^Q'bGl
U"D*<tdfD>8\eTBS2VJ5BRcx\94al.u0>mY_HKD9PUKgHCKF%.ZH[d_Wr(jD>wmfF
U"aa$m_C.%(*1S6Kc&&GkzBefS2i[2hJCvc8]DZ^bDn+bime#Zbrd&krDoE?#%A#c
U"0JZ9$6OAHTQ'KfI5lG+EZnqhFFEtZU()E59L:<8uLXiePdp7HSh)i_l')D6]Qw-
U"2.)x?jWw$$8aq>O,\xpo10opKbu)Vk+q]KNSz%9o(5dQ:,y2CQ.q1xUy;1N^E#<
U"9PT%vkuY;._J/9%sEV:$-FX0UE=+Q)$QSTI1tRIbXtMP9Yu'Q9'N/mM&tvPukR8
U"bU[7BJ)<5UjBXKSV[zTOKlgIe3VC0IaEhj&6[Efj4#>:3i#9Ww=\I2hJO75ZP$7
U"p<oW?<Pe2-.v#>NnBT-RlqF4g5RT;ab-_7e?)j:W6p<-#3x9h,cYd[wT&W(Rd6#
U"N%<ERib(#&.f;6W*Zn*RGfiJ%j,u1NUJ%2(a/J?AoWBx^-Cj71V9&M'T7/gI?>%
U"h<iM7YvQebpN(02G/j,&I*m/K)lO,aGUL;[c6k5>_j;FpT[rY&w4YDKuyQn4niU
U")Y6uiJpdkp<7,&1ADO^(?0&3Kf%-,F7DQu5;=-:?U&;2hak+L3W5/uZB51k,94A
U"O0;:B2JpOqW1?JYjN2gvOgJ))1k#e(92JS-;f2-J\Q?G4J]Z;-5J>4;vXj2f'sX
U"5X3'rU<zBq/LQ)jFrrAb.;K<q$OJq2AXn<b&m^6qU>/+j-BVqw/qN8KI4WHWZB0
U"6;mMq7H']nK^8nNHVO^?3k0BpaNK(VHlfBTgurK>C4OqW2A>PBt&.xc3WHD]?b5
U"NMhG%+r.W;$h%/gV.g-gU82K7C[^[jKThm;TD58YQ1dX'Yhs8c-:RqG_**n+?/g
U"1l0r#UQAX]*WnMU[$XP4m*t/)C;Rn<)f5.6Y'H]Nc39Dr-k&i]WamgF3D-K;fo\
U"NvZ3tFzX1,5sr2vbBr.rm9_A_rq4*LTa*V[vMpIgOHCb\j-(,[qsvNIdWssPp*<
U"dPc,r8uY[SnUEXZAM2EjbgG3FC9rS,2H/Mo_k)NPJW[*^>.FH?No'(N=ESN/n(7
U"]tXVG4Z](52])Y4C6B%WlWdkP6fX<&%VYW_&kqtH&%)-q*OV6lk(n(/J;>d,GpG
U"%OQ7:2d,cNk*(>JR;xkKNu64ov)-?WC(dRG%O8oIjP3(AUc-)OxNS-cIOz7.sa3
U"#:d7&:H+=wh6KMimO0;omqm%Xx'k>T9q\v>dHFEFB\53:MDSo3H$RDKK3L(4,]B
U".$BpiIcNP=AF2fr,S2kA0-0hkouF+7b>ZaV&3F\co#6.Wsuu0u9=CusnjKQbpy&
U"kBh[6Z*bmzpR?nk,^l)K*KGLAO;,XZDto::LsxXZ6?)iz4VR#__X.Jl:earcgm]
U"u#;B6#s?dC1VJMH6Zrqw41m2U;G<YXRi5pqH1R0n,-ZMVus*QMvB:MKB]upUQdZ
U"3K]=7cQc.3e:0pY1sjFiiCE.:J&9iY0ia.&#vm>),+z_FcshcIxB=,GHPX6fa/H
U"[.gt+p'pi:$HW_lc6&Bb*7PypILs<mK9sd^n?EbB<B16ZzqJ+N?\C30iQ'M+r93
U"T<C/jTDPW$Z0yCT,s.>=]?yn<a8<DbHt9=_83D&^-[dFc4WMuYx^5jyN^1EL^2Z
U"is\j,qJ+O1aK*-h<DacyWp687-l$XP$\^<v7.Qrc*Kd0cdHQnSr]meKm:ORh5rf
U"U\qb,P8Ab;xtf3XiPc_E2DYB?e8bHg)x=t_GNlX86gDSfVFn5OvcrZ)$G0;zy$;
U"B-+^$,5J_4sw2B#<BYvnM>_EJ%?%2H&_Q+,t3^Drr<_A1PD2>g8v0Bd#?,rDrj#
U"d9'9UZ_;7;'OuVdUC_jP$c^Xq^O.,yy%NbsxKO^%XVX_'KYVx.#O'QeWi,'Ppbt
U"oGNE&(D+rrD?Q]LYSVF>n+,9Rn$2hy,w>Gh>9(\/<A+Ak6ks,fBn_tqulF-8u0u
U"%p()9%%%%-I%FW_UDAP3'9U*%(%C0%%%/%%%%wjf%irjSCy'y\k%TATd[5LhOqx
U"0r9Bqe>bi.B4G8Us*G,aiXIRNak0Dx6J.gG158?&I/?tnV*^Te94.x^EiF'QbJ$
U"G-%mehKRZnDabVu9xx-V6MuPSNCTAtr^6)73z.>OKL3e#qdK?/N7na;MsvAA+?0
U"b4C5[ts480XL\FtdudE<BudP$)1Mpj:X;(jnI94KMm-X,k=#-[Nq7n%m_-7crg3
U"BfBj9W6?S4;n)LcE7wQ6))GLm]Acoc'wwPYD*6imnx->1b\J+[#K\QLBGe8+YHh
U".m*)zIgSlRrB/oL6#W/a,JZ%<Iwn.Q(\/jO2BplYU?_w(JZJ;s9HqZPFXC]x-PY
U"Xv?&Kr$4PgtN[AQ2:?LW>%Blq_'4.mT:%6QvND$%+EFjYZY;.OA02T-s6.]h'\<
U"OGk%&eApRp=*6\7VP-v[>kjYF&PKQXjZBYmX9#Cd9_T51IGx%<>[T+g1VE*1rCl
U"t6.VG[An3l>Dm+C]Q_Bj3r3zL>Mb^JvZ(?x0eIkM(Sa+SkEaEC&%Pe48o,6/P8l
U"2tU-MD=W05<_nB[cJ,,7<C^C#xy4_ub#$MXQ*pTC3,]J\k/%o9z;;>n>#6m=pe^
U"<;6%[en-u\?CG.e66BsG28Vo*BrjMmFM,-_?a(0nO4S;mLz%M*M*xNNlAHdMAwy
U".:0\&<uV\3X''b>(gqvDJR:4$*z85aW/<p_49=;ciD/6Q#iLSl+=2Bgql6i^,]3
U"/lsT4AZ\#;Krja>h.27=[uneu**0'Spn3l2cIMZ4A6Vs$Tx_TMZRsN*NlKUu4bf
U"Rjaa]7F56zU0fYnbHXlqCj^OR<I-k1Bt\X/+Mu-Pk<1/6DE1'>t9EKMWc#7(2ip
U"4m-(b9aB<-70C67DLsZ$_tVMj=JwuC]S9Wqu#(HV%Jnl$F&1gAM=8Zpsf#)w953
U"U+t?kJsX)d$H)g3RA6>2%h=6]g/C*v,duKwRug(LU+]^.04Mc)$%T;/ofM/I1lp
U"NI6LbG/r(-;:D4,#T3?Jc/[<oA/6rix$RB6'Z_,i0$th$-;[?(qIK2OLlRltijt
U"mSM]J7a>$gUA0&o*zJ-sr/;4LYS=P?DTf[EVCWCN]qE*sDcVE4f'oYF*U6YnL-W
U"eA4wy(KCj=;0fwj5A]:pTK]V<rDN:[_so'dM5OmN%5+\)StnN&CC9ENW\JJekJO
U"VTV6l\2u#w0<I5Df;vBq-;uk[A]Y2I2JA<p&,-mA)l)sg[na=M5R-_t1;72Xk?o
U"^2ig4R<a%H^8UkH9gZtI;IkAn#d0P2)0<qoD#qHDc\fCDAf4C+e%-mTh0_p$k&=
U"e<Pat,]pwJs&.koL(d-8v+6,/wbh&i088SjU0[#C]'cc7eO:/&6-ISZNdL[[w%C
U"tIzQO8Er^VFW^<g635<AuH;(g+_F-;ip\N2i2(>&yJqJdLdPU(7$T\L10('GmXv
U"G$QA6-/:Wnm=VrW*nvWLU8A'.-oHtHZ)o^?x&X?S0bl3hAFNw7[.rnP$CQRf>Wc
U"xmpq_)<5;3HWz*phsiD$:K9AvVb#E8YCE4q[#1abl2GNG].lS=RuK,Mk0Iekl>b
U"F40&gYHKR>Hfb:%$\Qyg6jI#>$m\Ok5T=VRODHJ?Ho^9o0XBD,EVECWb+]0gggU
U"w83&sLa_7GIU7?(jl:gUC0Chl[V6clSpMS8'iCG9S3<tA>%l8/L*02tE]5<WzGq
U",ZGW6^k.u%p()9%%%%-I%;W_:Dlg-&7.&%+%k&%%%0%%%%yjx%ywiu%SgfxDD_f
U":ARU=Uoh*x<[$>q:>\o)h[,biF(og_n5CI,k)w(Pq[RVbeuXH--*,TgEpIH7$-t
U"Wa%XEad5rpr)L9VkD+&5P2ONNC<>0-YyDn=9o6+gp2sh2eM^8k/Cd/wX#KLVL4(
U"X&kqH[aj.Z^9q1(D'GI*d*='3tsU0i>L;+\91,gNR4pp/8/N[z%kw;f:=,0#tq.
U"un85THc)WOM]3DefAb:F-+Pp=x$dzkX)HTQ[/s01>/BgVQX(Fu.E9T/.fW8.(d/
U"yyD\1qCEDoF0E_3l6zpg0e)x4zE#<4d9;_\DK^0_.CO1M(I=DkzgG70E6/YBZdy
U"UEh4;JsHoiq%,up&%'9%9%%%%-O%5U_#DYGA-B1,%(%XE%%%.%%%%%%%%%%%E%%
U"%%%%%%%w%jinr%Sugz%up&'%9%9%%%%-%1FW_DkAP39%U*%%&C0%%%/%%%%%%%%
U"%&%E%7%%X,%%%wj%firj.Sy'y%up&'%9%9%%%%-%1;W_DGlg-7%.&%%'k&%%%0%
U"%%%%%%%%&%E%%%%\2%%%yj%xywi%uSgf%xup*%+%%%%%(%((%w%%(%83%%%%%
END SUB
CLOSE:IF S=244AND B&=Z&THEN?" :) Ok!"ELSE?" :( Bad!
SUB U(A$):FOR A=1TO LEN(A$):C=ASC(MID$(A$,A))-37:IF C<0THEN C=91+C*32
IF K<4THEN K=C+243ELSE?#1,CHR$(C+(K MOD 3)*86);:K=K\3:B&=B&+1
S=(S+C)AND 255:NEXT:LOCATE,1:?STRING$(B&*50\Z&,219);:END SUB