home *** CD-ROM | disk | FTP | other *** search
/ Monster Media 1994 #1 / monster.zip / monster / PROG_BAS / PRO98SRC.ZIP / RIP.BAS < prev    next >
BASIC Source File  |  1994-02-01  |  3KB  |  121 lines
  1. $IF NOT %NORIP
  2. SUB RIP (S$)
  3.         if s$="" then exit sub
  4.     RipPrint "!|"
  5.     if val(left$(s$,1)) then
  6.             ripprint left$(s$,2)
  7.                 s$=mid$(s$,3)
  8.         else
  9.             RipPrint left$(s$,1)
  10.                 s$=mid$(s$,2)
  11.         end if
  12.         if s$="" then RipPrint chr$(13):exit sub
  13.         for y=1 to len(s$)
  14.             b$=mid$(s$,y,1)
  15.                 if b$="2" then
  16.                     RipPrint meganum2$(val(poparg$))
  17.                         iterate for
  18.                 end if
  19.  
  20.                 if b$="1" then
  21.                     RipPrint meganum1$(val(poparg$))
  22.                     iterate for
  23.                 end if
  24.  
  25.                 if b$="3" then
  26.                     RipPrint meganum3$(val(poparg$))
  27.                         iterate for
  28.             end if
  29.                 if b$="4" then
  30.                     RipPrint meganum4$(val(poparg$))
  31.         end if
  32.  
  33.                 if b$="$" then
  34.                     RipPrint poparg$
  35.                 iterate for
  36.                 end if
  37.  
  38.                 if instr("<>[]?",b$) then
  39.                     RipPrint b$
  40.                         iterate for
  41.                 end if
  42.  
  43.                 if b$="0" then
  44.                     RipPrint "0"
  45.                         iterate for
  46.                 end if
  47.  
  48.                 if litflag then
  49.                     RipPrint b$
  50.                         litflag=%false
  51.                     iterate for
  52.                 end if
  53.  
  54.                 if b$="_" then
  55.                     litflag=%true
  56.                 end if
  57.     next y
  58.         RipPrint chr$(13)
  59. END SUB
  60.  
  61. FUNCTION MEGANUM1$(n%)
  62.     if n%<36 then
  63.             MEGANUM1$=MID$("0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ",n%+1,1)
  64.     else
  65.             MEGANUM1$="0"
  66.     end if
  67. END FUNCTION
  68.  
  69. FUNCTION MEGANUM2$(n%)
  70.     if n%<36 THEN
  71.             MEGANUM2$="0"+MID$("0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ",n%+1,1)
  72.     else
  73.                 h%=(n%\36)
  74.                 l%=n%-(h%*36)
  75.                 h$=MID$("0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ",h%+1,1)
  76.                 l$=MID$("0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ",l%+1,1)
  77.         MEGANUM2$=h$+l$
  78.     end if
  79. END FUNCTION
  80.  
  81.  
  82.  
  83. FUNCTION MEGANUM3$(n%)
  84.     if n%<36 THEN
  85.             MEGANUM3$="00"+MID$("0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ",n%+1,1)
  86.     else
  87.                 h%=(n%\36)
  88.                 l%=n%-(h%*36)
  89.                 h$=MID$("0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ",h%+1,1)
  90.                 l$=MID$("0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ",l%+1,1)
  91.         MEGANUM3$="0"+h$+l$
  92.     end if
  93. END FUNCTION
  94.  
  95.  
  96. FUNCTION MEGANUM4$(n&)
  97. radix=36
  98.                 d4&=n&\(radix*radix*radix)
  99.                 d3&=(n& - (d4&*(radix*radix*radix)) )\(radix*radix)
  100.  
  101.                 d2&=(n&- ((d4&*(radix*radix*radix)) + (d3&*(radix*radix))))\radix
  102.  
  103.                 d1&= n&-((d4&*(radix*radix*radix))+(d3&*(radix*radix))+(d2&*radix))
  104.  
  105.  
  106.                 d4$=MID$("0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ",d4&+1,1)
  107.                 d3$=MID$("0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ",d3&+1,1)
  108.                 d2$=MID$("0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ",d2&+1,1)
  109.                 d1$=MID$("0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ",d1&+1,1)
  110.         MEGANUM4$=d4$+d3$+d2$+d1$
  111. END FUNCTION
  112.  
  113.  
  114.  
  115. sub ripprint (x$)
  116.     comprint x$
  117.         ansiprint x$
  118. end sub
  119.  
  120.  
  121. $ENDIF