Ascii Generator for the HP48

Ascii Four 
Ascii making program for the: 
HP48 s/g/sx/gx Programmable Calculators

Author:	  Wanda Louise
		        bab...@linknet.kitsap.lib.wa.us
          bab...@aol.com
Created:  Early 1997

Directory Name :: Ascii4
What It Does.
Creates an Ascii Graphic from a 1 Bit Dithered Pict.
Usually to very often-- you'll have to print the resulting Ascii graphic to
really appreciate all the subtleties that are generated!
what i especially like about this program is that it randomly (?) generates
characters for a specified amount of grey, so that there's a certain amount of
imposed texture to the resulting ascii graphic...???!


%%HP: T(1)A(D)F(.);
C$ 5157 AsciiFour
Name: Fish
Width: 68
Total: 4940
Time: 01:08:31  
                                                                 
                          ');sEj,                                
                         TNf<]^4oJ                               
                        ]lg6{*>,*Cn                              
                       [f*I|E'wy.*Fc                             
                      4FZ {=,]gjUvr@r                            
                     toJ]Lr\[T4Gfhir3/                           
                    hf@nhOPiizw!lV\kpb.                          
                   %ks!v%\hA1,++-"|[}6Z~                         
                  J}g P%8b"Nl ?>fvcr!Vpm                         
                 zj/&}r6dJi#J':,,""`/'KQI                        
               /K?Y=r2X}19Ho_(\.<-~'+-XFAJ                       
              `SY}ci |nl4a%<'i _, Y__V1CX#x                      
             \O<}+v?Ijv=: ` ~)( ~~! !fT*M0F,                     
            ~6u,::JTrC(+/!;\  -(!_( &;rl2C&g                     
            DFK>vj1Tu%rcjfx;t]=v=sInw]}64phTk                    
           xh%|`zi*nY|{\<iVVri}Y/v,r_>X]lA|Vf.                   
           3l>>r_ *><(ru*|")c}(.]=>T**{{2|l=T1                   
          ]n}t>?+Yx:(:r]&`~-+=}~r,-i4_+cli1T=a                   
          ysI{?j}} Yw::F6]_^rxYx.YI=1|rF-1/f;I7                  
         [O{}\`\V (c=W">er_r^  Yl,(*(zk rvxY"u?                  
         y**;Y<17/1_'t+oy{x 1JL_ ,{Lz/'<x~\/}7&                  
         8h{>x`,?r^?~)  *63{J.  Ynl)|)~1\-=+`*3                  
         UV<'+w&? :^  ?Y^ Fv! Jk- ]=~t?X7 ,"->9f%9g8Y;           
        :Sk7\" '`^{/`.,)   .Jhl   Xo;|+I6\?~iTU*ff&U3I*n>.       
        cyo>^ox-?!x<,rr  |!Y,-` (.KX4VVXa!^+ I5t]vkhVv[(fCzf`    
     _;KKV=l-Y*4v.k_"~,~  \-) ,  *eafl]JpI> | WF>?|=<|,V7Lk&lnr  
   )a]<{V3Y+!!  "!i (((! )x1^_  cJKz*ffjcO',=}F*<L}xJi}kklcutJ]m 
  (- +Xfej[]C- ~,_|i-r .L ~_ `  [e7jtjcLT8V|("1C  UIIo>1Cz[xtIpx 
   >n?."+U}i^^Lm; Y`Xc? )Y=  ) )s]tKklJlca2)/i{c  |DIhyyKF&w?Y   
 /z;",[n]:f?jnT ' r' < -/' _JL 7TLtfco]*nU% 1/i4   (o<1[J>-      
 / -LT' \6]r>r;x,"o+/ Le[) !  {XkX4cz]chLhz /1 P                 
  Ls^ _I[t=o1J|kc? :|f7  i .  .dfLzj]CteV@r,(' j"                
 if )x[| k+=}?Y_!/ =- ,-`_' :{:KujnWSz6yz=</ :x;>                
   ^z> ^VV7[`}}_1.\"?, x).x " c2uSQSDCuFV<", -/f7                
  )l  ;V^x;Yg}x!~!+`^   ) = :\Y4qZM4X2g. .\->.jc:                
  ) 'n? /7rzv7(*[ -!>x<vY /^ '=CnnpFy* +"(_  <|l                 
    n/ Yc^Lcc!}{"' `)1\ {a7*   jS%b4"'  ^^? ?TVL                 
   Iv rs!rJsivi_?^/I1V `>~)\ -x\XRX? " >"<-? `'n                 
   - ,f uj +VleJ1|} "{?) !~ Y Y^ J\` (? "_~=_ {v1                
     Y YY^iVI=L >=:!  Yx(^~ ^ /_-  )!\ ~ (\- <!k:                
       j JC\wnYrf)=~ (`.|\ "`.!< < /(`!  x<L x>Jc                
        Vc  P[cc=|.r!  ": ':? -<  -'/,"--{.;!rK+>})              
        q (7<VlftY{]+^/^ 1:*~\  ^ \~x...~?c`rxku1vi>             
         -SL}T?c7lV_+sIk jx  <<}/: -)^"),"Y%77k[f4yTY            
        \&;it:cc{J}L:\]"l t<,^!.'^ ;/;{Y|;}=t1n+twucV-           
        hk=]> TTYlLf:tt;~>"<` ^|~ ?.!!|~(|xVtj{csXfW[p           
       /M({/l/=}*7r=aV' ~~\?=-Y?r)wlx|,`;&CvfxjUnaan[p           
       Ll[!i==k=YLi&{lr*_`;)x,) ^Y`.!i?]Vz*tvt9JK?qhjFL          
       zk?i=;t|>>J<ft[z<:[^>c?v_(  =;?c92FVjfFf3ol>4rkt          
      -J[\VYk~]!*k7*]kSgtvc1`-x_v~=/;1P I%O4&uLFh%or/TK          
      Yh:% ]->/t<>TkoU LP~V =`:L" 1^};] j5Kg$JEvS[z_K %`         
      "I4>TxV^?{~c(9v#>-4x?x 'x_i).YJ%| W$X2hCVg:%Y/(X:-         
       h;kK`1 [/xrX}FOF P:L|r!1- *i|rS  Ht;XLW?z`j`T!wDv         
       ~I4>K-c=;t?l %&t es.;v|(v( 1{kK  51u1e[[V\c=JtLG          
        J:?Y*|+[v7rlgff VJt*~~?"?k;=Tu  u=;J>L.%vkj:ak           
         fK^V]Yt?Kt9V]1 )7zz!x`1"{vvJ4  _ojL/2vfC hiC            
         _Y*t^cxiK=LTk   K])v=x_~Y**oo   YKt_37II1&V~            
           "}il}=Vr;,    D| hr(?r,n|\b     >YuC7GV|              
                         P?V}Y-<"Yn}TqY                          
                         Pg%]*LYk=*II]g                          
                        TEPUljVJt;tKu5O)                         
                       _2e#OO%ZU4mCg@4z4                         
                       FT4ZenbaSC3a3K&7a<                        
                      |tTZo4&FCLh*wf%oaj&)                       
                      IYue9*co%z{JVzo&fjkk                       
                     "k[C]7ck&3<ejJVI]PVLK^                      
                     ?h]Fc%]9sae4CwYjeeCV%e                      
                     KelohCcogFEK6paU*oLaK9*                     
                    -hnygfGnQONMD#pZ4wnefO4O;                    
                    }SDo4OGuqPE6R@@2WADzS%OG3                    
                    kdCNZ$OoR554%IeENHMAFGm@N                    
                    *0PW05RWR&.     cDM@0Qydi                    
                    (ARd8G8&          [M0$Nf                     
                     ~FwLc/             }=!                      
                                                                 

How It Works.
Ascii Four Takes 2 arguments;
Either a Grob, List of Grobs, a Name or List of Names
& the Number of Characters that you'd like final Ascii art thinger to be in
width.
If you input a list of Grobs &/or Names, then the list also has to include the
Desired Width of each Ascii Object, alternating with the Grobs &/or Names.
It then decides how large the sample of pixels should be for each character and
determines how dark it is, assigning the darkest characters to the darkest
areas on the Grob.
If you used a Name to refer to a Grob to be used, the resulting String will be
stored it that Name, overwriting the original Grob.

INPUT:
2:	Grob or 'Name of Grob'
1:	Desired Width
or
1:	{ Grob Width 'Name' Width � }

RESIDUE:
1:	String
or 
		 String Stored in Name Provided


Subroutines:

Start	
Start is the Core Program that Makes the Ascii Strings from a Grob or Grobs.
	How It Works.
	See Above
----------------------------------------------------------------

Grab	
GrabOut-- you may wish to trim the Grob down to it's Outer most parameters,
GrabOut will do that for you.
	How It Works.
	Grab trims the clear/blank boarders that may surround the Grob that you want
to convert to an Ascii object.

	INPUT:
	1:	Grob with Boarder(s)

	RESIDUE:
	1:	Naked Grob
----------------------------------------------------------------

->8x8	
8by8 determines how dark a fragment of the Grob is in order to assign a
proportionally dark character to that relative location on the Ascii String.
	How It Works.
	8by8 can only work on grob fragments no bigger than 8 by 8 pixels...!  --So
this means that if you want to create an Ascii String 70 characters wide, then
the largest Grob you can use will be 560 pixels wide.

	INPUT:
	1:	Grob no larger than 8 by 8

	RESIDUE:
	1:	No. of black pixels in it
----------------------------------------------------------------

$tr	
String of Charcters from lightest to darkest.
----------------------------------------------------------------

T/?	
Time Elapsed...??? Determines the amount of time that's elapsed since a TICKS
was taken and presents a String defining that period.
	How It Works.
	Takes a TICKS binary number which is an internal object marker of how many
tiny fractions of second has gone by since the clock was last set (???).

	INPUT:
	1:	TICKS

	RESIDUE:
	1:	"hh:mm:ss"
	or
	1:	"dd::hh:mm:ss"
----------------------------------------------------------------

Alrm	
Alarm sounds a unique alarm for roughly 20 seconds.
	How It Works.
	Takes no input from the stack and leaves no residue.
	To shut it off prematurely, hit ON.
----------------------------------------------------------------

Bep	
One of 4 Beeping Noises.
	How It Works.
	Bep takes either a 1, 2, 3 or a 4 and returns a specific kind of bep for each.

	INPUT:
	1:	1, 2, 3 or 4
----------------------------------------------------------------

Clik?	
Counts the number of times a key, containing a reference to Clik?, has been
poked, minus one. .
	How It Works.
	Put this at the beginning of a program and it will count how many times the
key activating that program has been hit, minus one.
	Thus; if you hit the key only once, as might be expected, then a 0 will be
returned to the stack.

	INPUT:
	Number of times key is poked

	RESIDUE:
	1:	Poked - 1
----------------------------------------------------------------

PPAR	
Plot PARameters
----------------------------------------------------------------


>-----------------------------------------------------< :: | :: > 
Primary Algorythm Listing:

Name:	Ascii4
Size:	2881.0
CheckSum:	# CFDAh



%%HP: T(3)A(D)F(.);
DIR
  Start
    \<< .2 WAIT KEY
      \<< DROP
"2: GROB/Name
1: DesiredWidth"
"" INPUT OBJ\->
      \>> IFT DUP
TYPE 5 \=/
      \<< 2 \->LIST
      \>> IFT \-> \163
      \<< CLLCD 1 \163
SIZE
        FOR \Ga \163 DUP
SIZE \Ga - 2 / CEIL 2
DISP \Ga \Ga 1 + SUB
OBJ\-> DROP OVER TYPE
11 ==
          \<< 1 CF
          \>>
          \<< 1 SF
OVER RCL SWAP
          \>> IFTE
OVER SIZE B\->R SWAP
B\->R 0 0 0 0 13 CHR
10 CHR + TICKS \-> w
y x px py \->$ \GD cr \Gt
          \<< x w /
CEIL DUP 1.333 *
CEIL 'py' STO 'px'
STO x px / CEIL px
* DUP 'x' STO R\->B y
py / CEIL py * DUP
'y' STO R\->B BLANK {
# 0h # 0h } ROT
REPL PICT STO 94 px
py * / '\->$' STO x
px / y py / * '\GD'
STO "AsciiFour" cr
+ 1 FS?
            \<<
"Name: " 3 PICK cr
+ + +
            \>> IFT
"Width: " w cr + +
+ "Total: " \GD cr +
+ +
"Time:           "
cr + + 0 y py -
            FOR q 0
x px -
              FOR p
PICT p R\->B q R\->B 2
\->LIST p px + 1 -
R\->B q py + 1 - R\->B
2 \->LIST SUB \->8x8
DUP
\<< $tr SWAP \->$ *
RAND \->$ * - DUP SUB
\>>
\<< DROP " "
\>> IFTE + '\GD' DECR 4
DISP px
              STEP
cr + py
            STEP
DUP "Time" POS 6 +
\Gt :&: T\:-? EVAL REPL
1 FS?
            \<< SWAP
STO
            \>> IFT
          \>> 2
        STEP 1 CF
:&: Alrm EVAL
      \>>
    \>>
  Grab
    \<< :&: Clik?
EVAL DUP
      \<< PICT RCL
SWAP
      \>> IFT SWAP
DUP DUP TYPE 11 ==
      \<< DUP2 SIZE
BLANK \=/
      \>> 0 IFTE
      \<< SIZE DUP2 1
- SWAP 1 - SWAP 4
ROLL 4 ROLL DROP 0
1 ROT SWAP R\->B
BLANK # 0h # 0h \-> g
x y v h m w
        \<<
          WHILE g
# 0h w 2 \->LIST x w
2 \->LIST SUB h ==
          REPEAT
'w' 1 STO+
          END
          WHILE g
# 0h y 2 \->LIST x y
2 \->LIST SUB h ==
          REPEAT
'y' 1 STO-
          END # 1h
y 1 + BLANK 'v' STO
          WHILE g m
# 0h 2 \->LIST m y 2
\->LIST SUB v ==
          REPEAT
'm' 1 STO+
          END
          WHILE g x
# 0h 2 \->LIST x y 2
\->LIST SUB v ==
          REPEAT
'x' 1 STO-
          END g m w
2 \->LIST x y 2 \->LIST
SUB SWAP
          \<< x w 2
\->LIST PX\->C "PMAX"
\->TAG m y 2 \->LIST
PX\->C "PMIN" \->TAG
          \>> IFT
        \>>
      \>>
      \<< ROT DROP2
      \>> IFTE
    \>>
  \->8x8
    \<< BIN \->STR 9 99
SUB "#" SWAP "h" +
+ OBJ\-> \->STR \-> \162
      \<< 0 1 \162 SIZE
        FOR $ \162 $ $
SUB "1" ==
          \<< 1 +
          \>> IFT
        NEXT DEC
      \>>
    \>>
  $tr
C$ 96 
'`.-/\\^_~!",()<>|:+?irvx{}1;=Yfjlt*7IJLT[]cVknouw%CXsz&4FKaehmpqy2369PSUZ
gDGObd$58HNQAEMRW0@#B#
  T\:-?
    \<< RCLF \-> \183
      \<< STD -55 CF
-41 SF DATE TICKS
ROT - B\->R 29491200
/ \->HMS 24 / DUP IP
DUP 0 >
        \<< "::" +
        \>>
        \<< DROP ""
        \>> IFTE 3
ROLLD FP 24 * TSTR
15 22 SUB + \183 STOF
      \>>
    \>>
  Alrm
    \<< -56 CF DEPTH
\->LIST RAND 6 * 2 +
CEIL \-> h y
      \<<
        IFERR { } 1
y
          START
RAND 4400 * + RAND
+
          NEXT 1 8
          START DUP
EVAL 1 y
            START
BEEP
            NEXT
          NEXT
        THEN
        END CLEAR h
OBJ\-> DROP -56 SF
      \>>
    \>>
  Bep
    \<< { { 20 15 .5
} { 100 20 .1 } {
2000 500 .02 } {
4000 1000 .005 } }
SWAP GET EVAL \-> a b
c
      \<< -56 CF RAND
a * b + c BEEP -56
SF
      \>>
    \>>
  Clik?
    \<< 0
      WHILE .2 WAIT
KEY
      REPEAT DROP 1
+
      END 4 :&: Bep
EVAL
    \>>
  PPAR {
(-6.5,-3.1)
(6.5,3.2) X 0 (0,0)
FUNCTION Y }
END